unit Util;

interface
uses
  Windows, SysUtils, Grids,IniFiles,    TypInfo,
  dateUtils, jvHLEditor, ShellApi,
  classes,IBQuery, controls,  db,
  forms, messages, Graphics,
  ComCtrls, Dialogs, stdCtrls, MPlayer,UDefs, strUtils,
  jvBrowseFolder, Math, System.Win.Registry, Winapi.WinInet;

type
  { Wizard ACLES }
  TEvento = procedure ( sender: TObject) of object;

  TPageState = (psDiscard, psUse, psShowing, psHidded);
  TPageStateSet = set of TPageState;
  TPageReturn = (prRetornable, prNonRetornable, prFinal, prInicial, prMeio, prCancelable);
  TPageReturnSet = set of TPageReturn;
  TPageAction = (aAvancar, aRetroceder, aCancelar, aFinalizar);

  TBotao = (btCancelar, btVoltar, btAvancar, btFinalizar);
  TBotoes = set of TBotao;
{-------------------------------------------------------------------------------}

  TDoOnDblClick = procedure (Sender: TObject) of object;

  TTypeDelTree = (delFull, delEmpty, delFileMask);
  {Mouse Functions}
  function GetWinTitleOnCursorPos: string;


  {File and path Functions}
  procedure MyFolderFilesRecurse(aFolderName: string; var aList: TStrings; aExt: string = '*.*');
  procedure MyFolderFiles(aFolderName: string; var aList: TStrings; aExt: string = '*.*');
  procedure MyFolderGetList(aFolderName: string; var aList: TStrings; aExt: string = '*.*');
  procedure MyFileGetList(aFolderName: string; var aList: TStrings; aExt: string = '*.*');
  function MyFileExists(aFullFileName: string): string;
  function MyDelFile(aFullFileName: string): boolean;
  function MyCopyFile(aFullFileName: string; aNewName: string;
      aFailIfExists: boolean = false): boolean;
  function MyMoveFile(aFullFileName: string; aNewName: string;
      aFailIfExists: boolean = false): boolean;
  function MyDelTree(aPath: string; aType: TTypeDelTree;
      aFileMask: string = '*.*'): boolean;
  {}
  function UpperCaseA(St:string):string;
  function LowerCaseA(St:string):string;
  function UpperCaseB(const S: string): string;
  function LowerCaseB(const S: string): string;

  {}
  function IsUrl(S: string): Boolean;
  function IsUrlI(aValue: string): boolean;
  function RemoteConnection: boolean;
  function estaNaInternet: boolean;

  {}
  function GetNamePortion(aValue: string): string;
  function RemoveHttp(aURL: string): string;
  function IncludeHttp(aURL: string): string;
  function GetName(aValue: string): string;

{}
function SetNameForFile(aFolder: string; aFileNameBase: string = 'Novo arquivo';
    aExtencion: string = '.cor'): string;
  
{
Essa função tem o objetivo de executar um aplicativo externo (o Bloco de Notas por exemplo).
Quando este programa for executado, o seu aplicativo será automaticamente minimizado e será restaurado automaticamente quando o programa que foi executado for finalizado.

Ela retorna True se tudo ocorreu bem e False caso ocorra algum erro (caso o aplicativo indicado não exista, por exemplo)
}
  function ExecWaiting(Arquivo : String; aMinRestore: boolean = true):boolean;

  {}
  function IsHourForToday(aHora: string; aToday: TTime): boolean;

  {}
  function SelGen(aTable: string):string;

  {}
  function ReplaceSubstring( StringAntiga, StringNova, s : string ) : string;
  function StringsToString(aStrings: TStrings): string;

  {Mega Sena Utils}
    function MakePositive(aDif: integer): integer;
    function GetComb(aObj: integer; aOrd: integer): integer;
  function Fatorial(aN: integer): integer;
  function GetDez(aItem: integer): integer;
  function SetSeqName(aTipo: integer): String;
  function SetAcertoName(aTipo: integer): string;


  {}
  function IncludeChr(aValue: string; aChr: integer = 39): string;
  function SetZNumber(aNumber: integer; aDigits: integer = 2): string;

  {}
  function GetPercent(aPercent: integer; vMax: integer): integer; overload;
  function GetPercent(aPercent: Real; vMax: Real): integer; overload;
  function GetPercent(aPos: real; vMin,vMax: real): integer; overload;
  function GetPercent(aPos: integer; vMin,vMax: integer): integer; overload;


  {}
  procedure ListItemRemoveKey(aItemsToRemove: TStrings; var aItems: TStrings; aParent: TWinControl);
  procedure ListItemRemove(aItemsToRemove: TStrings; var aItems: TStrings; aParent: TWinControl);

  procedure ListItemAddKey(aItemsToAdd: TStrings; var aItems: TStrings;
      aFirst: boolean);
  procedure ListItemAdd(aItemsToAdd: TStrings; var aItems: TStrings;
      allowDup: boolean = false; aFirst: boolean = false);

  function ValidaJogo(aItem: string; aSep: string = ';'; Min: Integer = 1; Max: integer = 60): boolean;

  function sortCommaSep(aItem: string; aSep: string = ';'): string;
  procedure ListSort(var aItems: TStrings; aParent: TWinControl);
  procedure SortList(var vLines: TStrings; aParent: TWinControl);

  {}
  Function FileLengthEx( sFile:String; aFileName: boolean = true):Extended;
  Function FileLengthExStr( sFile:String; aFileName: boolean = true):String;
  Function FileLength( sFile:String):Integer;

  procedure setRootBrowseFolder(aLocation: string; aBrowse: TJvBrowseForFolderDialog);
  function CriarDir(aDir: string; aSlash: string = '\'):boolean;
  function RemoverDir(aDir: string; aItensCountDown: integer = 1):boolean;

  {Procedimentos para LOG}
  procedure LogRead(aLines:TStrings; aFileName: string = 'Log.log');
  procedure LogWrite(aLog: string; aLines: TStrings; aFileName: string = 'Log.Log'; aTipo: string = 'Exception');
  procedure LogClear(aFileName: string);
  procedure LogGet(aFileName: string; aLines: TStrings);
  procedure logAddLine(aLine: string);

  {Funções para compatibilidade com tradutor}
  function GetLangStr(aBRStr: string; aLangFile: TStrings): string;
  function GetBRAStr(aLangStr:string; aLangFile: TStrings): string;

  function GetUpdateInfo(aAppName: string; aLines: TStrings): string;

  {}
  function Extenso( Numero: Integer; vMoeda: boolean = false) : string;

  {Listas de inteiros e Strings}
  Function ListIntIsIn(aValues: TArrayInt; aValue: integer): boolean;
  Function ListIntPos(aValues: TArrayInt; aValue: integer): Integer;
  function ListIntAddPilha(var aValues: TArrayInt; aValue: integer; aLimite: integer; var aIndex: integer; aFirst: boolean = false): boolean;
  procedure ListIntAddFIFO(var aValues: TArrayInt; aValue: integer; aLimite: integer; var aIndex: integer);
  function ListIntIns(var aValues: TArrayInt; aValue: integer; var aIndex: integer;
                    aPos: integer = 0; aOverWrite: boolean = true;
                    aLimite: integer = -1): boolean;


  Function ListStrIsIn(aValues: TArrayStr; aValue: string): boolean;
  Function ListStrPos(aValues: TArrayStr; aValue: string): Integer;
  function ListStrAddPilha(var aValues: TArrayStr; aValue: string; aLimite: integer; var aIndex: integer; aFirst: boolean = false): boolean;
  procedure ListStrAddFIFO(var aValues: TArrayStr; aValue: string; aLimite: integer; var aIndex: integer);
  function ListStrIns(var aValues: TArrayStr; aValue: string; var aIndex: integer;
                    aPos: integer = 0; aOverWrite: boolean = true;
                    aLimite: integer = -1): boolean;

  {}
  function getMonthName(aMonth: integer; aLang: TStrings = nil): string;



  function GetZeros(aNumber: integer): Integer;
  function includeZeros(aNumber: string; aZeros: Integer = 1): string; overload;
  function includeZeros(aNumber: integer; aZeros: Integer = 1; aNone: string = ''): string; overload;
  function includeZerosToMax(aNumber: Integer; aMax: Integer): string;
  function ReturnNumbers(aMask: string):string;
  function ReturnMeses(aMask: string; aLang: TStrings):string;
  function ReturnDatas(aMask: string):string;
  function ChangeSep(aStr: string; aOldSep, aNewSep: string): string;
  function GetSep(aStr: string): string;
  function ContItensFromStrComaSep(aStr:String; aSep: string = ';'): integer;
  function GetItemFromStrComaSep(aStr: string; aIndex: integer; aSep: string = ';'): string;


  {Busca binára}
  function BuscaBinaria (Vetor: TStringList;
                         aChave: string;
                         aPos, aMin, aMax: Integer;
                         aAnterior: string = 'None'
                         ): string; overload;

  function SetLimits(Vetor: TStringList;
                     aItem: string;
                     aPos, aMin, aMax: Integer;
                     aAnterior: string = 'None'
                     ): string;

  function BuscaBinaria (Vetor: TStrings; Chave: string; aMax: integer): integer; overload;


  {Hash}
  procedure LeituraDeHash(aStg: TStringGrid; aLines: TStrings);
  procedure CriarRomanos(aFPath,aFFile: string);

  {  Funções Genéricas}
  procedure jumpTo(aHWND:hwnd; aComando,aTipo:string; aDir: string = '');
  procedure jumpToII(aHWND:hwnd; aProgram:string; aParam:string; aLocation: string = ''; aAction:string= 'Open');
  procedure mensagemDeDesconexao(aSnlConnected: boolean);
  function ZeraVetStr2xX(const max: integer):TvetStrIII;
  Function achaNumStr(b:string):Byte;
  Function achaStrNum(b,f:byte):string;
  Function LimpaStr(VStr:string):string;
  function myTrim(aString: String; LimpaINI: boolean = true; LimpaFim: boolean = true):string;
  function retornaPonto(ffloat:string):string;
  function GetTimeFrom(data:TDateTime): TTime;
  function GetDateFrom(data:TDateTime): TDate;
  function MyDateToStr(data:TDateTime):string;
  function TimeCompletion(pTime: string): string;
  function getNumber(aStr: string):integer;
  function myStrCharPos(aSubStr: string; aStr: string): integer;
  function RemoverSlash(aPath: string; aSlash: string = '\'): string;
  function IncluirSlash(aPath: string; aSlash: string = '\'; aInclude: boolean = true): string;
  function ChangeSlash(aPath: string; aSlash: string = '\'; aToSlash: string = '/'): string;
  function RemoveDiskFromPath(aPath: string): string;
  function RemoveDiskPointFromPath(aPath: string): string;

  procedure DoUpdateSetas(aStrings: TStrings; aDirecao: TDirecao = dDown);

  {  Funções avançadas  }
  function HasProperty(aComponent: TComponent; aPropertyName: String): boolean;
  procedure SetIntegerPropertyIfExists(AComp: TComponent; APropName: String;
    AValue: Integer);
  procedure SetObjectPropertyIfExists(AComponent: TComponent; APropName: String;
    AValue: TObject);
  procedure SetBooleanPropertyIfExists(AComp: TComponent; APropName: String;
    AValue: Boolean);
  procedure SetStringPropertyIfExists(AComp: TComponent; APropName: String;
    AValue: String);
  procedure SetMethodPropertyIfExists(AComp: TComponent; APropName: String;
    AMethod: TMethod);

  {  Funções de Tree  }
  Function InserirNo(Tree:TTreeView; parent:TTreeNode; Tipo:TTipoNo; Texto:string; IMIndex,IStatIndex,ISelIndex:integer):TTreeNode; overload;
  Function InserirNo(Tree:TTreeView; parent:TTreeNode; Tipo:TTipoNo; Texto:string; IMIndex:integer):TTreeNode; overload;
  procedure CopyTree(aTreeFrom: TTreeView; aTreeTo: TTreeView; aNodeFrom,aNodeTo: TTreeNode);

  {  Funções de String Grids}
  function GetRegisterBD(aBDName: string; aTree: TTreeView; aBarParcial: TProgressBar = nil; aBarTotal: TProgressBar = nil): boolean;
  function RegisterBD(aServer, aPath: string; aGrid: TStringGrid; aBarParcial: TProgressBar = nil; aBarTotal: TProgressBar = nil): boolean;
  procedure setStgCabecalho(aGrid: TStringGrid; aNomes: string; aSep: string = ',');
  procedure LimpaGrid(aGrid: TStringGrid);
            //preenchimento
  procedure PreencheDown(aCol,lIni,lFim: integer; aValue: string; aGrid: TStringGrid);
  procedure PreencheLeft(aColIni,aColFim,aLinha: integer; aValue: string; aGrid: TStringGrid);
  procedure PreencheRight(aColIni,aColFim,aLinha: integer; aValue: string; aGrid: TStringGrid);
  procedure PreencheUP(aCol,lIni,lFim: integer; aValue: string; aGrid: TStringGrid);

  procedure IncDown(aCol,lIni,lFim: integer; aValue: string; aGrid: TStringGrid);
  procedure IncUP(aCol,lIni,lFim: integer; aValue: string; aGrid: TStringGrid);
  procedure IncRight(aColIni,aColFim,aLinha: integer; aValue: string; aGrid: TStringGrid);
  procedure IncLeft(aColIni,aColFim,aLinha: integer; aValue: string; aGrid: TStringGrid);

  procedure PreencheGrid(aLIni,aLFim,aCIni,aCFim: integer; aGrid: TStringGrid; aValue: string = '');
  function SomaSelGrid(aLIni,aLFim,aCIni,aCFim: integer; aGrid: TStringGrid): string;

  procedure stgKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState; aGrid: TStringGrid; aValue: string = '');

  {  Utilidades de Informação  }
  Function GetMyVerInfo(ExeName:string):TVetStrIII;
  Function GetVerInfo(aTipoInfo: string; aVerArray: TVetStrIII): string;

  {  Utilidades de Teclado  }
  function whatKey(key: word): string;
  function ThereIsAKeyDown: boolean;
  function ThereIsAKeyDownInt: integer;
  function ThereIsAKeyDownWord: Word;
  Procedure PostKeyEx32(Key: Word; const Shift: TShiftState; SpecialKey: boolean);

  {  Criptografia  }
  Function Embaralha(s:string):string;
  Function DesEmbaralha(s:string):string;
  function crypt(Action, Src: String; aAddKey: string = ''): String;

  {  Tratamento de data  }
  function validaDateTime(avalor: string):TTestaDateTime;
  function formatDateBR(aValor: string):string;
  function formatDateStrToBR(aValor: string):string;
  function myIncDate(aDtIni: TDate; aNumInc: integer; aIntervalo: integer;
         aDD: word; aFixaDia: Boolean = true): TDate;

  {  Tratamento de IP  }
  function GetValueIP(aIP: string; aPos: integer): word;


{______________________________________________________________________}

  Function GetFName(OD:TOpenDialog):String;


  Procedure MessageBar(STBar:TStatusBar; Mess:string);

  procedure Mostrar(PgCtrl: TPageControl;Capt:string; sim:boolean);
  Procedure ShowTabs(Tab:TPageControl; aCaptions:TArrayStr; sim:boolean); Overload;
  Procedure hideTabs(Tab:TPageControl; Index,Quantas:integer); Overload;
  Procedure hideTabs(Tab:TPageControl; names:TArrayStr; OPC:boolean); Overload;
  Procedure UpTabs(Tab:TPageControl; caption: string); overload;
  Procedure UpTabs(Tab:TPageControl; names:TArrayStr); overload;

  Function GetWord(P:String):TVetStr;
  Function GetWordII(P,separador:String):TVetStr;

  function ZeraVetStr:TvetStr;
  function ZeraVetStrII:TvetStrII;
  function ZeraVetStrIII:TvetStrIII;
  Function ZeraVetLimiteBase:TVetLimiteBase;
  Function ZeraVetLimiteMatrix:TVetLimiteMatrix;

  procedure AddButtons(ToolBar: TToolBar;
        Const ButtonCaptions: array of String);

  Procedure CheckTDiag(D1,D2:TDateTimePicker; LblDiag,LblDiagII:TLabel; DtNasc,DtColeta,HoraNasc,HoraColeta:string; check:TCheckBox);
  Function corrigeHora(hora:String):string;
  Function Falar(nomeArq:string; Criar,Esperar:boolean):TMediaPlayer;

  Function myVerInfo(ExeName:string):TVetStrIII;
  Function RetornaInfo(oQue:String; vVer:TVetStrIII):String;

  Procedure SalvaSelecao(List:TListBox; Memo:TMemo; NomeArq:string);
  Procedure CarregaSelecao(List:TListBox; Memo:TMemo; NomeArq:string);
  procedure criarGenerator(L:TListBox; memoSubst,memoDest:TMemo);

  function removeEspacofinal(V:TVetStr):TVetStr;
  Function PrepForSql(V:TVetStr; Invert: TInvData):TVetStr;

  function ValidaNIRE(num:string): boolean;
  function ValidaCGC(num:string): boolean;
  function ValidaCPF(num:string): boolean;

  function getIPFromNetRes(text:string): string;
  function getNameFromNetRes(text: string): string;
  function getNameMachineFromNetRes(text: string): string;

  function compactPath(pPath: string; pLength: integer): string;

  function GetUnicUsrName(aUsrName: string): string;

//Older
  Function MemoToLinha(memo:TMemo; Separador:string):String;
  Procedure LinhaToMemo(Linha:String;var memo:TMemo);
  Procedure SalvarLog(var memo:TMemo; User,Perfil,App,Caminho:String );

  { Projeto VSIndexer }

  function IsItVideo(aFileName: string): boolean;
  function IsItAudio(aFileName: string): boolean;
  function IsItMMRK(aFileName: string): boolean;
  function isItFolder(aString: string): string;

  function nota(aVal: Integer): string;

var
  MediaPlay: TMediaPlayer;
  snlAwayMode: boolean;
  FAppName: string;
  FAppPath: string;
  FAppDocs: string;
  FAppDocsUsr: string;
  FAppLogFile: TStrings;
  FAppLogLines: TStrings;
  FAppLogFileName: string;
  FAppLogTitle: string;
  _vVersion: TVetStrIII;

  FUsrLogado: boolean;
  FUsrName: string;



    FmAnexoUsr: string;
    FmFrom,
    FmName,
    FmEmpresa,
    fmRegistro,
    FmAssunto,
    FmTitulo: string;
    FmMessage:TStrings;

    FmTo: String;
    FmCC: String;
    FmCCO: string;
    FmPrioridade: integer;

    FmConfirm: boolean;


implementation


{}
function GetWinTitleOnCursorPos: string;
var
 hWindow: HWND;
 pt: TPoint;
// pIconInfo: TIconInfo;
 dwThreadID, dwCurrentThreadID: DWORD;
 vName: array [ 0..2047 ] of char;
 vFileNameEx: integer;

begin
// Result.hCursor := 0;
// ZeroMemory(@Result, SizeOf(Result));
 // Encontra a janela "mae" do mouse
 if GetCursorPos(pt) then
 begin
  // Result.ptScreenPos := pt;
   hWindow := WindowFromPoint(pt);
   try
     Windows.GetWindowText(hWindow,@vName,2047);
     result:= vName;
     if not(IsWindow(hWindow)) then result:='noWindow';
   except
     beep;
     exit;
   end;

   if IsWindow(hWindow) then
   begin
     // Pega a thread do owner do mouse
     dwThreadID := GetWindowThreadProcessId(hWindow, nil);

     // Pega o id da thread atual
     dwCurrentThreadID := GetCurrentThreadId;

     if (dwCurrentThreadID <> dwThreadID) then
     begin
       if AttachThreadInput(dwCurrentThreadID, dwThreadID, True) then
       begin
         // Obtem o handle do cursor
//         Result.hCursor := GetCursor;
         AttachThreadInput(dwCurrentThreadID, dwThreadID, False);
       end;
     end
     else
     begin
//       Result.hCursor := GetCursor;
     end;
   end;
 end;
end;



{}
procedure MyFolderFilesRecurse(aFolderName: string; var aList: TStrings; aExt: string = '*.*');
var
  i,j: integer;
  vList: TStrings;
begin
  try
  vList:= TStringList.Create;
  MyFolderGetList(aFolderName,vList);
  for i:= 0 to vList.Count-1 do begin
    aList.Add(vList.Strings[i]);
    MyFolderFilesRecurse(vList.Strings[i],aList,aExt);
//    for j:= i+1 to vList.Count-1 do begin
  //    aList.Add(vList.Strings[j]);
    //end;
  end;
  MyFileGetList(aFolderName,aList,aExt);
  finally
    vList.Free;
  end;
end;

procedure MyFolderFiles(aFolderName: string; var aList: TStrings; aExt: string = '*.*');
begin
  MyFolderGetList(aFolderName,aList);
  MyFileGetList(aFolderName,aList,aExt);
end;

procedure MyFolderGetList(aFolderName: string; var aList: TStrings; aExt: string = '*.*');
const
  ValidFileAttr = faAnyFile and not faVolumeID;
var
  SR: TSearchRec;
  vNewName: string;
  vAbort: boolean;
  vFounded: boolean;
  vFName: string;
  vPath: string;
  vFinal: string;

  function DoFileMatch: string;
  var
    vName: string;
    vExt, vExtCompare: string;
  begin
    result:= 'None';
    vExt:= ExtractFileExt(sr.Name);
    vExtCompare:= ExtractFileExt(aExt);
    if vExtCompare = '.*' then begin
      result:= sr.Name;
    end else begin
      if UpperCaseB(vExt) = UpperCaseB(vExtCompare) then
        result:= sr.Name;
    end;
  end;
begin
  {}
  vAbort:= false;
  vPath:= aFolderName;
  try
    if FindFirst(incluirSlash(vPath) + aExt, ValidFileAttr, SR) = 0 then
      try
        repeat
          if (SR.Name <> '.') and (SR.Name <> '..') then
            vNewName:= DoFileMatch;
          if (vNewName <> 'None') and (vNewName <> '') then begin
            vFinal:=IncluirSlash(vPath)+vNewName;
            if DirectoryExists(vFinal) then
              aList.Add(vFinal);
          end;
        until vAbort or (FindNext(SR) <> 0);
      finally
        FindClose(SR);
      end;
  Except
  end;
end;

procedure MyFileGetList(aFolderName: string; var aList: TStrings; aExt: string = '*.*');
const
  ValidFileAttr = faAnyFile and not faVolumeID;
var
  SR: TSearchRec;
  vNewName: string;
  vAbort: boolean;
  vFounded: boolean;
  vFName: string;
  vPath: string;
  vFinal: string;

  function DoFileMatch: string;
  var
    vName: string;
    vExt, vExtCompare: string;
  begin
    result:= 'None';
    vExt:= ExtractFileExt(sr.Name);
    vExtCompare:= ExtractFileExt(aExt);
    if vExtCompare = '.*' then begin
      result:= sr.Name;
    end else begin
      if UpperCaseB(vExt) = UpperCaseB(vExtCompare) then
        result:= sr.Name;
    end;
  end;
begin
  {}
//  aList.Clear;
//  result:= 'None';
//  vFounded:= false;
  vAbort:= false;
//  vFName:= ExtractFileName(aFullFileName);
  vPath:= aFolderName;
  try
    if FindFirst(incluirSlash(vPath) + aExt, ValidFileAttr, SR) = 0 then
      try
        repeat
          if (SR.Name <> '.') and (SR.Name <> '..') then
            vNewName:= DoFileMatch;
          if (vNewName <> 'None') and (vNewName <> '') then begin
//            vFounded:= true;
//            result:= IncluirSlash(vPath)+vNewName;
            vFinal:=IncluirSlash(vPath)+vNewName;
            if not(DirectoryExists(vFinal)) then
              aList.Add(vFinal);
//            vAbort:= true;
          end;
        until vAbort or (FindNext(SR) <> 0);
      finally
        FindClose(SR);
      end;
  Except
//    result:='Erro na pesquisa';
  end;
end;

function MyFileExists(aFullFileName: string): string;
const
  ValidFileAttr = faAnyFile and not faVolumeID;
var
  SR: TSearchRec;
  vNewName: string;
  vAbort: boolean;
  vFounded: boolean;
  vFName: string;
  vPath: string;

  function DoFileMatch: string;
  var
    vName: string;
  begin
    result:= 'None';
    if UpperCaseB(sr.Name) = UpperCaseB(vFName) then
      result:= sr.Name;
  end;
begin
  {}
  result:= 'None';
  vFounded:= false;
  vAbort:= false;
  vFName:= ExtractFileName(aFullFileName);
  vPath:= ExtractFilePath(aFullFileName);
  try
    if FindFirst(incluirSlash(vPath) + '*.*', ValidFileAttr, SR) = 0 then
      try
        repeat
          if (SR.Name <> '.') and (SR.Name <> '..') then
            vNewName:= DoFileMatch;
          if (vNewName <> 'None') and (vNewName <> '') then begin
            vFounded:= true;
            result:= IncluirSlash(vPath)+vNewName;
            vAbort:= true;
          end;
        until vAbort or (FindNext(SR) <> 0);
      finally
        FindClose(SR);
      end;
  Except
    result:='Erro na pesquisa';
  end;
end;

function MyDelFile(aFullFileName: string): boolean;
var
  vName: string;
begin
  result:= false;
  vName:= MyFileExists(aFullFileName);
  if (vName <> 'Erro na pesquisa') and
     (vName <> 'None') then
  try
    DeleteFile(vName);
    result:= true;
  except
    result:= false;
  end;
end;

function MyCopyFile(aFullFileName: string; aNewName: string;
    aFailIfExists: boolean = false): boolean;
var
  vName: string;
begin
  result:= false;
  vName:= MyFileExists(aFullFileName);
  if (vName <> 'Erro na pesquisa') and
     (vName <> 'None') then
  try
    CopyFile(pchar(vName),pchar(aNewName),aFailIfExists);
    result:= true;
  except
    result:= false;
  end;
end;

function MyMoveFile(aFullFileName: string; aNewName: string;
    aFailIfExists: boolean = false): boolean;
begin
  result:= false;
  try
    MyCopyFile(aFullFileName,aNewName,aFailIfExists);
    MyDelFile(aFullFileName);
    result:= true;
  except
    result:=false;
  end;
end;

function MyDelTree(aPath: string; aType: TTypeDelTree;
    aFileMask: string = '*.*'): boolean;
begin
  result:= false;
end;

{}
function UpperCaseB(const S: string): string;
var
  Ch: Char;
  L: Integer;
  Source, Dest: PChar;
begin
  L := Length(S);
  SetLength(Result, L);
  Source := Pointer(S);
  Dest := Pointer(Result);
  while L <> 0 do begin
    Ch := Source^;
    if (Ch >= 'a') and (Ch <= 'z') then Dec(Ch, 32);
    if (Ch >= 'á') and (Ch <= 'ú') then Dec(Ch, 32);
    if (Ch >= 'ã') and (Ch <= 'õ') then Dec(Ch, 32);
    if (Ch >= 'ä') and (Ch <= 'ü') then Dec(Ch, 32);
    if (Ch >= 'à') and (Ch <= 'ù') then Dec(Ch, 32);
    if (Ch >= 'â') and (Ch <= 'û') then Dec(Ch, 32);
    Dest^ := Ch;
    Inc(Source);
    Inc(Dest);
    Dec(L);
  end;
end;

function LowerCaseB(const S: string): string;
var
  Ch: Char;
  L: Integer;
  Source, Dest: PChar;
begin
  L := Length(S);
  SetLength(Result, L);
  Source := Pointer(S);
  Dest := Pointer(Result);
  while L <> 0 do begin
    Ch := Source^;
    if (Ch >= 'A') and (Ch <= 'Z') then Inc(Ch, 32);
    if (Ch >= 'Á') and (Ch <= 'Ú') then Inc(Ch, 32);
    if (Ch >= 'Ã') and (Ch <= 'Õ') then Inc(Ch, 32);
    if (Ch >= 'Ä') and (Ch <= 'Ü') then Inc(Ch, 32);
    if (Ch >= 'À') and (Ch <= 'Ù') then Inc(Ch, 32);
    if (Ch >= 'Â') and (Ch <= 'Û') then Inc(Ch, 32);
    Dest^ := Ch;
    Inc(Source);
    Inc(Dest);
    Dec(L);
  end;
end;

Function UpperCaseA(St:string):string;
var
  a:integer;
begin
  for a:=1 to Length(St) do
    if(St[a]in['a'..'z'])or(St[a]in['à'..'ý'])then Dec(St[a],32);
  Result:=St;
end;

function LowerCaseA(St:string):string;
var
  a:integer;
begin
  for a:=1 to Length(St) do
    if(St[a]in['A'..'Z'])or(St[a]in['À'..'Ý'])then Inc(St[a],32);
  Result:=St;
end;

{}
function IsUrlI(aValue: string): boolean;
const
  BADCHARS = ';*<>{}[]|\()^!';
var
  vCount: integer;
  function HasBadChars: boolean;
  var
    i: integer;
  begin
    result:= false;
    for i := Length(BADCHARS) downto 1 do
      if Pos(BADCHARS[i], aValue) > 0 then begin
        result:= true;
        break;
      end;
  end;
  function HasControls: boolean;
  var
    i: integer;
  begin
    result:= false;
    for i := 1 to Length(aValue) do
      if (Ord(aValue[i]) < 33) or (Ord(aValue[i]) > 126) then begin
        result:= true;
        break;
      end;
  end;
begin
  result:= false;
  if ansiPos('.',aValue) = 0 then exit;
  if HasBadChars then exit;
  if HasControls then exit;
  if ansiPos('http:',LowerCase(aValue)) <> 0 then begin result:= true; exit; end;
  if ansiPos('www.',LowerCase(aValue)) <> 0 then begin result:= true; exit; end;
  vCount:= ContItensFromStrComaSep(aValue,'.');
  if vCount >= 2 then result:= true;
end;

function IsUrl(S: string): Boolean;
//
// Testa se a String é uma url ou não
//
const
  BADCHARS = ';*<>{}[]|\()^!';
var
  p, x, c, count, i: Integer;
begin
  Result := False;
  if (Length(S) > 5) and (S[Length(S)] <> '.') and (Pos(S, '..') = 0) then
  begin
     for i := Length(BADCHARS) downto 1 do
         begin
         if Pos(BADCHARS[i], S) > 0 then
            begin
            exit;
            end;
         end;
     for i := 1 to Length(S) do
         begin
         if (Ord(S[i]) < 33) or (Ord(S[i]) > 126) then
            begin
            exit;
            end;
         end;
     if ((Pos('www.',LowerCase(S)) = 1) and (Pos('.', Copy(S, 5, Length(s))) > 0) and (Length(S) > 7)) or ((Pos('news:', LowerCase(S)) = 1) and (Length(S) > 7) and (Pos('.', Copy(S, 5, Length(S))) > 0)) then
         begin
           result:= true;
         end
     else if ((Pos('mailto:', LowerCase(S)) = 1) and (Length(S) > 12) and (Pos('@', S) > 8) and (Pos('.', S) > 10) and (Pos('.', S) > (Pos('@', S) +1))) or ((Length(S) > 6) and (Pos('@', S) > 1) and (Pos('.', S) > 4) and (Pos('.', S) > (Pos('@', S) +1))) then
              begin
              Result := True;
              Exit;
              end
     else if ((Pos('http://', LowerCase(S)) = 1) and (Length(S) > 10) and (Pos('.', S) > 8)) or ((Pos('ftp://', LowerCase(S)) = 1) and (Length(S) > 9) and (Pos('.', S) > 7)) then
             begin
             Result := True;
             Exit;
             end
          else
             begin
             Result := True;
             end;
     for Count := 1 to 4 do
         begin
         p := Pos('.',S) - 1;
         if p < 0 then
            begin
            p := Length(S);
            end;
          Val(Copy(S, 1, p), x, c);
          if ((c <> 0) or (x < 0) or (x > 255) or (p>3)) then
             begin
             Result := False;
             Break;
             end;
          Delete(S, 1, p + 1);
          end;
     if (S <> '') then
         begin
         Result := False;
         end;
  end;
end;


function RemoteConnection: boolean;
const
  Key = '\System\CurrentControlSet\Services\RemoteAccess';
  Value = 'Remote Connection';
var
  Reg: TRegistry;
  Buffer: DWord;
begin
  Result := false;

  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if Reg.OpenKey(Key, false) then
    begin
      Reg.ReadBinaryData(Value, Buffer, SizeOf(Buffer));
      Result := Buffer = 1;
    end;
  finally
    Reg.CloseKey;
    Reg.Free;
  end;
end;

function estaNaInternet: boolean;
var
flags : DWORD;
vflags : Cardinal;
vURL: PWideChar;
iOpen: Pointer;
iNative: NativeInt;
begin
//  result:= InternetGetConnectedState(@flags, 0);
//  case flags of
//  INTERNET_CONNECTION_CONFIGURED: result:= false;
//  INTERNET_CONNECTION_LAN: result:= False;
//  INTERNET_CONNECTION_OFFLINE: result:= false;
//  end;

//  vURL:= 'ftp.jles.net';
//  iOpen:= InternetOpen(vURL,INTERNET_OPEN_TYPE_PRECONFIG,nil,nil,flags);
//  result:= InternetConnect(iOpen,vURL,21,'jles','New3513Pass6542',INTERNET_SERVICE_FTP,vflags,iNative) <> nil;

  result:= InternetCheckConnection('http://www.acles.jles.net', 1, 0);
end;


{}
function GetNamePortion(aValue: string): string;
var
  vName: string;
  vCount: integer;
  vItem: string;
  vValue: string;
  i: integer;
begin
  vCount:= ContItensFromStrComaSep(aValue,'.');
  vItem:='';
  for i:= 1 to vCount-1 do begin
    vValue:= GetItemFromStrComaSep(aValue,i,'.');
    if vValue = 'None' then continue;
    vItem:= vItem + vValue+'.';
  end;
  vName:= IncluirSlash(vItem,'.',false);
  if vItem = '' then vName:= aValue;
  result:= vName;
end;

function RemoveHttp(aURL: string): string;
  begin
    result:= aURL;
    if ansiPos('http://',aURL) <> 0 then
      result:= copy(aURL,8,length(aURL));
  end;

function IncludeHttp(aURL: string): string;
  begin
    result:=aURL;
    if ansiPos('http://',aURL) = 0 then
      result:= 'http://'+aURL;
  end;

function GetName(aValue: string): string;
  var
    vCount: integer;
    i: integer;
    vItem: string;
  begin
    result:= aValue;
    vCount:= Util.ContItensFromStrComaSep(aValue,'.');
    if vCount <=1 then exit;
    vItem:='';
    for i:= 1 to vCount-1 do
      vItem:= vItem +Util.GetItemFromStrComaSep(aValue,i,'.')+'.';
    result:= IncluirSlash(vItem,'.',false);
  end;

{Function que retornará um nome seguido de um número para arquivos}
function SetNameForFile(aFolder: string; aFileNameBase: string = 'Novo arquivo';
    aExtencion: string = '.cor'): string;
var
  i: integer;
  vItem: string;
  vNumber: string;
  vNum: integer;
  vExt: string;
  vHasPoint: boolean;
begin
  vItem:= GetItemFromStrComaSep(aFileNameBase,1,'_');
  vNumber:= GetItemFromStrComaSep(aFileNameBase,2,'_');
  vNum:= StrToInt(vNumber);
  inc(vNum);
  vHasPoint:= ansiPos('.',aExtencion) <> 0;
  if not(vHasPoint) then
    vExt:= '.'+aExtencion else
    vExt:= aExtencion;
  result:= vItem+'_'+intToStr(vNum)+vExt;
end;

{
Essa função tem o objetivo de executar um aplicativo externo (o Bloco de Notas por exemplo).
Quando este programa for executado, o seu aplicativo será automaticamente minimizado e será restaurado automaticamente quando o programa que foi executado for finalizado.

Ela retorna True se tudo ocorreu bem e False caso ocorra algum erro (caso o aplicativo indicado não exista, por exemplo)
}

function ExecWaiting(Arquivo : String; aMinRestore: boolean = true):boolean;
var
  StartupInfo : TStartupInfo;
  ProcessInfo : TProcessInformation;
begin
  FillChar (StartupInfo, Sizeof(StartupInfo), #0);
  with StartupInfo do begin
    cb := sizeof(StartupInfo);
    dwFlags := STARTF_USESHOWWINDOW;
    wShowWindow := SW_SHOW;
  end;
  Result:=CreateProcess(nil,PChar(Arquivo), nil, nil, false, CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo);
  If Result then begin
    if aMinRestore then Application.Minimize;
    application.ProcessMessages;
    WaitForSingleObject(ProcessInfo.hProcess, Infinite);
    if aMinRestore then Application.Restore;
  end;
end;

{}
function IsHourForToday(aHora: string; aToday: TTime): boolean;
  var
    vRestoDoDia: integer;
    vItemForDay: integer;
    vZeroHoraStr: string;
    vAgora: TTime;
    vAgoraStr: string;
    vZeroHora: TTime;
    vTimeTo: TTime;
    vTeste: string;
//    vTimeToStr: string;
  begin
    vAgoraStr:= TimeToStr(aToday);
    vAgora:= StrToTime(vAgoraStr);
    vZeroHoraStr:= '23:59:59';
    vZeroHora:= StrToTime(vZeroHoraStr);
//    vTimeToStr:= TimeToStr(self.DTPHora.Time);
    vTimeTo:= StrToTime(aHora);
    vTeste:= TimeToStr(vTimeTo);
    vRestoDoDia:= SecondsBetween(vAgora,vZeroHora);
    vItemForDay:= SecondsBetween(vTimeTo,vZeroHora);
    result:= vItemForDay <= vRestoDoDia;
  end;

{}
function SelGen(aTable: string):string;
begin
  result:= 'select Gen_Id(Gen_'+aTable+',1) as Codigo from rdb$database';
end;

{}
function StringsToString(aStrings: TStrings): string;
var
  i: integer;
  vStr: string;
begin
  result:='';
  for i:= 0 to aStrings.Count-1 do begin
    vStr:= aStrings.Strings[i];
    vStr:= myTrim(vStr);
    result:= result+ vStr+ ' ';
  end;
  result:= MyTrim(result,false,true);
end;

{Mega Sena Utils}
function MakePositive(aDif: integer): integer;
    begin
      if aDif < 0 then
        result:= aDif* -1 else
        result:= aDif;
    end;

function GetComb(aObj: integer; aOrd: integer): integer;
var
  vDif: integer;
  vOrd: integer;
    begin
      vOrd:= aOrd;
      vDif:= MakePositive(aObj-aOrd);
      if vDif <= 0 then vDif:=1;
      if vOrd <= 0 then vOrd:=1;
      result:= util.Fatorial(aObj) div (util.Fatorial(vOrd) * (util.Fatorial(vDif)));
    end;

function Fatorial(aN: integer): integer;
var
  i: integer;
begin
  result:=aN;
  for i:= aN-1 downto 1 do
    result:= Result * i;
end;

function GetDez(aItem: integer): integer;
  begin
    result:=-1;
    if aItem <= 10 then result:= 10;
    if (aItem > 10) and (aItem <= 20) then result:= 20;
    if (aItem > 20) and (aItem <= 30) then result:= 30;
    if (aItem > 30) and (aItem <= 40) then result:= 40;
    if (aItem > 40) and (aItem <= 50) then result:= 50;
    if (aItem > 50) and (aItem <= 60) then result:= 60;
  end;


function SetSeqName(aTipo: integer): string;
  begin
    result:= 'None';
    case aTipo of
    2: result:= 'Dupla';
    3: result:= 'Tripla';
    4: result:= 'Quadrupla';
    5: result:= 'Quintupla';
    6: result:= 'Sextupla';
    end;
  end;

function SetAcertoName(aTipo: integer): string;
  begin
    result:= 'Nada';
    case aTipo of
    1: result:= 'Solo';
    2: result:= 'Duque';
    3: result:= 'Terno';
    4: result:= 'Quada';
    5: result:= 'Quina';
    6: result:= 'Sena';
    end;
  end;

{}
function IncludeChr(aValue: string; aChr: integer = 39): string;
begin
  result:= 'None';
  case aChr of
  39: result:= chr(39)+aValue+chr(39);//'
  34: result:= chr(34)+aValue+chr(34);//"
  end;
end;

function SetZNumber(aNumber: integer; aDigits: integer = 2): string;
  function SetDigit(aDig: integer = 1): string;
  begin
    case aDig of
    1: result:= '0'+intToStr(aNumber);
    2: result:= '00'+intToStr(aNumber);
    3: result:= '000'+intToStr(aNumber);
    4: result:= '0000'+intToStr(aNumber);
    5: result:= '00000'+intToStr(aNumber);
    end;
  end;
begin
  result:=IntToStr(aNumber);
  case aDigits of
  2: if aNumber < 10 then result:= setDigit;
  3: begin
      if aNumber < 10 then result:=SetDigit(2);
      if (aNumber > 10) and (aNumber< 100) then result:= setDigit;
    end;
  4: begin
      if aNumber < 10 then result:=SetDigit(3);
      if (aNumber > 10) and (aNumber< 100) then result:= setDigit(2);
      if (aNumber > 100) and (aNumber< 1000) then result:= setDigit;
    end;
  5: begin
      if aNumber < 10 then result:=SetDigit(4);
      if (aNumber > 10) and (aNumber< 100) then result:= setDigit(3);
      if (aNumber > 100) and (aNumber< 1000) then result:= setDigit(2);
      if (aNumber > 1000) and (aNumber< 10000) then result:= setDigit;
    end;
  6: begin
      if aNumber < 10 then result:=SetDigit(5);
      if (aNumber > 10) and (aNumber< 100) then result:= setDigit(4);
      if (aNumber > 100) and (aNumber< 1000) then result:= setDigit(3);
      if (aNumber > 1000) and (aNumber< 10000) then result:= setDigit(2);
      if (aNumber > 10000) and (aNumber< 100000) then result:= setDigit;
    end;
  end;
end;

{Porcentagens}
function GetPercent(aPercent: integer; vMax: integer): integer; overload;
begin
  result:= (aPercent * vMax) div 100;
end;

function GetPercent(aPercent: Real; vMax: Real): integer; overload;
 var
    vPercReal: real;
    vPerc: integer;
    vMult: real;
    vPercStr: string;
  begin
    try
      vMult:=(aPercent * vMax);
      vPercReal:= trunc(vMult / 100);
      vPercStr:= FloatToStr(vPercReal);
      vPerc:= StrToInt(vPercStr);
      result:= vPerc;
    except end;
 end;

function GetPercent(aPos: real; vMin,vMax: real): integer;
  var
    vPercReal: real;
    vPerc: integer;
    vMult: real;
    vPercStr: string;
  begin
    try
      vMult:=(aPos * 100);
      vPercReal:= trunc(vMult / vMax);
      vPercStr:= FloatToStr(vPercReal);
      vPerc:= StrToInt(vPercStr);
      if vPerc > 100 then vPerc := 100;
      result:= vPerc;
    except end;
  end;
  
function GetPercent(aPos: integer; vMin,vMax: integer): integer;
  var
    vPerc: integer;
    vMult: integer;
  begin
    try
      vMult:=(aPos * 100);
      vPerc:= trunc(vMult div vMax);
      if vPerc > 100 then vPerc := 100;
      result:= vPerc;
    except end;
  end;

{ Tomar cuidado!
  "ListItemRemoveKey" remove todas as chaves em "aItemsToRemove" para todas
  as linhas em "aItems"... isto significa que se aItems contiver uma seção inteira
  com vários Headers...

  as chaves de mesmo nome em todos os headers e na seção serão removidas.
}
procedure ListItemRemoveKey(aItemsToRemove: TStrings; var aItems: TStrings; aParent: TWinControl);
var
  vMyList: TListBox;
  i,j: integer;
  vItem: string;
  vAdd: boolean;
  vKey: string;
  vCompareStr: string;
  function isLineKey(aLine: string): boolean;
  begin
    result:= pos('=',aLine)<> 0;
  end;
begin
  vMyList:= TListBox.Create(application);
  vMyList.Parent:= aParent;
  With vMyList do
  try
    Sorted:= false;
    visible:= false;

    for i:= 0 to aItems.Count-1 do
      Items.Add(aItems.Strings[i]);
    aItems.Clear;
    for i:= 0 to Count-1 do begin
      vItem:= Items.Strings[i];
      vAdd:= true;
      if isLineKey(vItem) then begin
        for j:= 0 to aItemsToRemove.Count-1 do begin
          vKey:= GetItemFromStrComaSep(vItem,1,'=');
          vCompareStr:= aItemsToRemove.Strings[j];
          if vKey = vCompareStr then begin
            vAdd:=false;
            break;
          end;
        end;
      end;

      if vAdd then
        aItems.Add(Items.Strings[i]);
    end;

  finally
    free;
  end;
//  vLines:= vMyList.Items;
end;

procedure ListItemRemove(aItemsToRemove: TStrings; var aItems: TStrings; aParent: TWinControl);
var
  vMyList: TListBox;
  i,j: integer;
  vItem: string;
  vAdd: boolean;
begin
  vMyList:= TListBox.Create(application);
  vMyList.Parent:= aParent;
  With vMyList do
  try
    Sorted:= false;
    visible:= false;
{    Items:= vLines;
    vLines:= Items;
}

    for i:= 0 to aItems.Count-1 do
      Items.Add(aItems.Strings[i]);
    aItems.Clear;
    for i:= 0 to Count-1 do begin
      vItem:= Items.Strings[i];
      vAdd:= true;
      for j:= 0 to aItemsToRemove.Count-1 do
        if vItem = aItemsToRemove.Strings[j] then begin
          vAdd:=false;
          break;
        end;
      if vAdd then
        aItems.Add(Items.Strings[i]);
    end;

  finally
    free;
  end;
//  vLines:= vMyList.Items;
end;

procedure ListItemAddKey(aItemsToAdd: TStrings; var aItems: TStrings;
    aFirst: boolean);
var
  vMyList: TStrings;
  i: integer;
  vItem: string;
  vAdd: boolean;

  function isLineKey(aLine: string): boolean;
  begin
    result:= pos('=',aLine)<> 0;
  end;

  function KeyIsInDest(aItem: string): boolean;
  var
    i: integer;
    vKey,vKeyDest: string;
    vValue: string;
    vItemDest: string;
  begin
    result:= false;
    vKey:= GetItemFromStrComaSep(aItem,1,'=');
    vValue:= GetItemFromStrComaSep(aItem,2,'=');
    for i:= 0 to aItems.Count-1 do begin
      vItemDest:= aItems.Strings[i];
      vKeyDest:= GetItemFromStrComaSep(vItemDest,1,'=');
      if uppercase(vKey) = uppercase(vKeyDest) then begin
        aItems.Strings[i]:= aItem;
        result:= true;
        break;
      end;
    end;
  end;
begin
  vMyList:= TStringList.Create;
  With vMyList do
  try
    for i:= 0 to aItems.Count-1 do
      Add(aItems.Strings[i]);
    aItems.Clear;

    if aFirst then begin
      for i:= 0 to aItemsToAdd.Count-1 do begin
        vItem:= aItemsToAdd.strings[i];
        if isLineKey(vItem) then begin
          if not(KeyIsInDest(vItem)) then
            aItems.Add(aItemsToAdd.Strings[i]);
        end;
      end;
    end;

    for i:= 0 to Count-1 do
      aItems.Add(Strings[i]);

    if not(aFirst) then begin
      for i:= 0 to aItemsToAdd.Count-1 do begin
        vItem:= aItemsToAdd.strings[i];
        if isLineKey(vItem) then
          if not(KeyIsInDest(vItem)) then
            aItems.Add(aItemsToAdd.Strings[i]);
      end;
    end;
  finally
    free;
  end;

end;

procedure ListItemAdd(aItemsToAdd: TStrings; var aItems: TStrings;
    allowDup: boolean = false; aFirst: boolean = false);
var
  vMyList: TStringList;
  i,j: integer;
  vItem: string;
  vAdd: boolean;

  function IsInDest(aItem: string): boolean;
  var
    i: integer;
    vItemDest: string;
  begin
    result:= false;
    for i:= 0 to aItems.Count-1 do begin
      vItemDest:= aItems.Strings[i];
      if uppercase(aItem) = uppercase(vItemDest) then begin
        result:= true;
        break;
      end;
    end;
  end;
begin
  vMyList:= TStringList.Create;
  With vMyList do
  try
    for i:= 0 to aItems.Count-1 do
      Add(aItems.Strings[i]);
    aItems.Clear;

    if aFirst then begin
      for i:= 0 to aItemsToAdd.Count-1 do begin
        vItem:= aItemsToAdd.Strings[i];
        if not(allowDup) then
          if not(IsInDest(vItem)) then
            aItems.Add(aItemsToAdd.Strings[i]);
      end;
    end;

    for i:= 0 to Count-1 do
      aItems.Add(Strings[i]);

    if not(aFirst) then begin
      for i:= 0 to aItemsToAdd.Count-1 do begin
        vItem:= aItemsToAdd.Strings[i];
        if not(allowDup) then
          if not(IsInDest(vItem)) then
            aItems.Add(aItemsToAdd.Strings[i]);
      end;
    end;

  finally
    free;
  end;
end;

function ValidaJogo(aItem: string; aSep: string = ';'; Min: Integer = 1; Max: integer = 60): boolean;
var
  vCount: integer;
  vItem: string;
  vItemInt: integer;
  i: Integer;
  vList: TStringList;
  function repetido: boolean;
  var
    i, j: Integer;
    vItemI, vItemII: string;
  begin
    result:= False;
    for i := 0 to vList.Count -1 do
    begin
      vItemI:= vlist.Strings[i];
      for j := 0 to vList.Count -1 do
      if i <> j then
      begin
        vItemII:= vList.Strings[j];
        if vItemI = vItemII then
        begin
          result:= True;
          exit;
        end;
      end;
    end;
  end;
begin
  result:= true;
  vList:= TStringList.Create;
  vList.Sorted:= true;
  vCount:= ContItensFromStrComaSep(aItem,aSep);
  vItem:='';
  for i := 1 to vCount do
  begin
    vItem:= GetItemFromStrComaSep(aItem,i,aSep);
    try
      vItemInt:= StrToInt(vItem);
    except
      result:= False;
      exit;
    end;
    if (vItemInt < Min) or (vItemInt > Max) then
    begin
      result:= False;
      exit;
    end;
    vList.Add(vItem);
  end;

  if Repetido then
    result:= False;
  vList.Free;
end;

function sortCommaSep(aItem: string; aSep: string = ';'): string;
var
  vCount: integer;
  vItem: string;
  i: Integer;
  vList: TStringList;
begin
  vList:= TStringList.Create;
  vList.Sorted:= true;
  vCount:= ContItensFromStrComaSep(aItem,aSep);
  for i := 1 to vCount do
  begin
    vItem:= GetItemFromStrComaSep(aItem,i,aSep);
    vList.Add(vItem);
  end;
  for i := 0 to vList.Count -1 do
  begin
    if i < vList.Count -1 then
      result:= Result + vList.Strings[i]+ ';' else
      result:= Result + vList.Strings[i];
  end;
  vList.Free;
end;


procedure ListSort(var aItems: TStrings; aParent: TWinControl);
begin
  SortList(aItems,aParent);
end;

procedure SortList(var vLines: TStrings; aParent: TWinControl);
var
  vMyList: TListBox;
  i: integer;
begin
  vMyList:= TListBox.Create(application);
  vMyList.Parent:= aParent;
  With vMyList do
  try
    Sorted:= true;
    visible:= false;
{    Items:= vLines;
    vLines:= Items;
}

    for i:= 0 to vLines.Count-1 do
      Items.Add(vLines.Strings[i]);
    vLines.Clear;
    for i:= 0 to Count-1 do
      vLines.Add(Items.Strings[i]);

  finally
    free;
  end;
//  vLines:= vMyList.Items;
end;

{}
Function FileLengthExStr( sFile:String; aFileName: boolean = true):String;
const
  cByte: extended = 8;
  cKb: extended = 1024;
  cMb: extended = 1000*1024;
  cGb: extended = 1000*(1000*1024);
//  cTb: extended = 1000*(1000*(1000*1024));
var
  vLength: integer;
  vSigla: string;
  vTam: Extended;
begin
  if aFileName then
  vLength:= FileLength(sFile) else
  vLength:= StrToInt(sFile);
  if (vLength > cKb) and (vLength < cMb) then begin
    vSigla:='Kb';
    vTam:= vLength / cKb;
  end;
  if (vLength > cMb) and (vLength < cGb) then begin
    vSigla:= 'Mb';
    vTam:= vLength / cMb;
  end;
  if (vLength > cGb)
  //and (vLength < cTb)
  then begin
    vSigla:= 'Gb';
    vTam:= vLength / cGb;
  end;
//  if (vLength > cGb) and (vLength < cTb) then begin
  //  vSigla:= 'Gb';
    //vTam:= vLength / cGb;
//  end;
  result:= FormatFloat('#,##0.00',vTam)+' '+vSigla;
end;

Function FileLengthEx( sFile:String; aFileName: boolean = true):Extended;
const
  cByte: extended = 8;
  cKb: extended = 1024;
  cMb: extended = 1000*1024;
  cGb: extended = 1000*(1000*1024);
//  cTb: extended = 1000*(1000*(1000*1024));
var
  vLength: integer;
  vTam: Extended;
  vTamStr: string;
begin
  if aFileName then
  vLength:= FileLength(sFile) else
  vLength:= StrToInt(sFile);
  if (vLength > cKb) and (vLength < cMb) then begin
    vTam:= vLength / cKb;
  end;
  if (vLength > cMb) and (vLength < cGb) then begin
    vTam:= vLength / cMb;
  end;
  if (vLength > cGb)
  //and (vLength < cTb)
  then begin
    vTam:= vLength / cGb;
  end;
//  if (vLength > cGb) and (vLength < cTb) then begin
  //  vSigla:= 'Gb';
    //vTam:= vLength / cGb;
//  end;
  vTamStr:=FormatFloat('#,##0.00',vTam);
  result:= StrToFloat(vTamStr);
end;

Function FileLength( sFile:String):Integer;
var
  iFileHandle: Integer;
  iFileLength: Integer;
begin
  try
    iFileHandle := FileOpen(sFile,fmOpenRead);
    iFileLength := FileSeek(iFileHandle,0,2);
    FileClose(iFileHandle);
  except
    iFileLength := 0;
    FileClose(iFileHandle);
  end;
  Result:=iFileLength;
end;

procedure setRootBrowseFolder(aLocation: string; aBrowse: TJvBrowseForFolderDialog);
  begin
    if (aLocation = 'fdProgramFiles') or
       (uppercase(aLocation) = 'PROGRAMAS') or
       (aLocation = 'Arquivos de programas') then
      aBrowse.rootDirectory:= fdProgramFiles;

    if (aLocation = 'fdProgramFilesCommon') or
       (uppercase(aLocation) = 'COMUNS') or
       (aLocation = 'Arquivos comuns') then
      aBrowse.rootDirectory:= fdProgramFilesCommon;

    if (aLocation = 'fdPersonal') or
       (Uppercase(aLocation) = 'USR FOLDER') or
       (Uppercase(aLocation) = 'USR') or
       (Uppercase(aLocation) = 'USER') or
       (uppercase(aLocation) = 'USUARIO') or
       (aLocation = 'Usuário')
    then
      aBrowse.rootDirectory:= fdPersonal;

    if (aLocation = 'fdPrograms')
    then
      aBrowse.rootDirectory:= fdPrograms;

    if (aLocation = 'fdRecent') or
       (uppercase(aLocation) = 'RECENT FILES') or
       (uppercase(aLocation) = 'RECENT')
    then
      aBrowse.rootDirectory:= fdRecent;

    if (aLocation = 'fdSendTo') or
       (uppercase(aLocation) = 'SEND TO') or
       (uppercase(aLocation) = 'SEND')
    then
      aBrowse.rootDirectory:= fdSendTo;

    if (aLocation = 'fdRecycleBin') or
       (uppercase(aLocation) = 'LIXEIRA') or
       (uppercase(aLocation) = 'LIXO')
    then
      aBrowse.rootDirectory:= fdRecycleBin;

    if (aLocation = 'fdDesktop') or
       (uppercase(aLocation) = 'DESKTOP')
    then
      aBrowse.rootDirectory:= fdDesktop;

    if (aLocation = 'fdDesktopDirectory') or
       (uppercase(aLocation) = 'DESKTOP DIR') or
       (uppercase(aLocation) = 'DESKTOP FOLDER')
    then
      aBrowse.rootDirectory:= fdDesktopDirectory;

    if aLocation = 'fdMyComputer' then
      aBrowse.rootDirectory:= fdMyComputer;

        { CSIDL_FAVORITES }
    if (aLocation = 'Favoritos') or
       (aLocation = 'fdFavoritos') then
       aBrowse.rootDirectory:= fdFavorites;

    if aLocation = 'fdControlPanel' then
      aBrowse.rootDirectory:= fdControlPanel;
    if aLocation = 'fdNetwork' then
      aBrowse.rootDirectory:= fdNetwork;
    if aLocation = 'fdFonts' then
      aBrowse.rootDirectory:= fdFonts;
    if aLocation = 'fdNoSpecialFolder' then
      aBrowse.rootDirectory:= fdNoSpecialFolder;
    if aLocation = 'fdRootFolder' then
      aBrowse.rootDirectory:= fdRootFolder;
    if aLocation = 'fdNetHood' then
      aBrowse.rootDirectory:= fdNetHood;
    if aLocation = 'fdPrinters' then
      aBrowse.rootDirectory:= fdPrinters;
    { Version 4.71 }
    if (aLocation = 'fdAppData') or
      (uppercase(aLocation) = 'APPLICATION DATA') or
      (uppercase(aLocation) = 'DADOS DA APLICACAO') or
      (uppercase(aLocation) = 'APP DATA') or
      (uppercase(aLocation) = 'ROAM') or
      (uppercase(aLocation) = 'ROAMING')
    then
      aBrowse.RootDirectory:= fdAppData;
//    fdAppData, { CSIDL_APPDATA }


    if (aLocation = 'fdCommonAppData') or
      (uppercase(aLocation) = 'APPLICATION DATA COMUM') or
      (uppercase(aLocation) = 'DADOS DA APLICACAO COMUM') or
      (uppercase(aLocation) = 'APP DATA COMUM') or
      (uppercase(aLocation) = 'ROAM COMUM') or
      (uppercase(aLocation) = 'ROAMING COMUM')
    then
      aBrowse.RootDirectory:= fdCommonAppData;
//    fdCommonAppData, { CSIDL_COMMON_APPDATA }

    (*
    fdStartMenu, { CSIDL_STARTMENU }
    fdStartup, { CSIDL_STARTUP }
    fdTemplates, { CSIDL_TEMPLATES }
    fdStartUpNonLocalized, { CSIDL_ALTSTARTUP }
    fdCommonStartUpNonLocalized, { CSIDL_COMMON_ALTSTARTUP }
    fdCommonDocuments, { CSIDL_COMMON_DOCUMENTS }
    fdCommonFavorites, { CSIDL_COMMON_FAVORITES }
    fdCommonPrograms, { CSIDL_COMMON_PROGRAMS }
    fdCommonStartUp, { CSIDL_COMMON_STARTUP }
    fdCommonTemplates, { CSIDL_COMMON_TEMPLATES }
    fdCookies, { CSIDL_COOKIES }
    fdFavorites, { CSIDL_FAVORITES }
    fdHistory, { CSIDL_HISTORY }
    fdInternet, { CSIDL_INTERNET }
    fdMyMusic, { CSIDL_MYMUSIC }
    fdPrinthood, { CSIDL_PRINTHOOD }
    fdConnections, { CSIDL_CONNECTIONS }


    { Version 4.72 }
    fdInternetCache, { CSIDL_INTERNET_CACHE }

    { Version 5.00 }
    fdAdminTools, { CSIDL_ADMINTOOLS }
    fdCommonAdminTools, { CSIDL_COMMON_ADMINTOOLS }
    fdCommonAppData, { CSIDL_COMMON_APPDATA }
    fdLocalAppData, { CSIDL_LOCAL_APPDATA }
    fdMyPictures, { CSIDL_MYPICTURES }
    fdProfile, { CSIDL_PROFILE }
    fdProgramFiles, { CSIDL_PROGRAM_FILES }
    fdProgramFilesCommon, { CSIDL_PROGRAM_FILES_COMMON }
    fdSystem, { CSIDL_SYSTEM }
    fdWindows, { CSIDL_WINDOWS }

    {  Version 6.00 }
    fdCDBurnArea, { CSIDL_CDBURN_AREA }
    fdCommonMusic, { CSIDL_COMMON_MUSIC }
    fdCommonPictures, { CSIDL_COMMON_PICTURES }
    fdCommonVideo, { CSIDL_COMMON_VIDEO }
    fdMyDocuments, { CSIDL_MYDOCUMENTS }
    fdMyVideo, { CSIDL_MYVIDEO }
    fdProfiles, { CSIDL_PROFILES }

    { Unknown version }
    fdResources, { CSIDL_RESOURCES }
    fdResourcesLocalized,
    fdCommonOEMLinks, { CSIDL_COMMON_OEM_LINKS }
    fdComputersNearMe { CSIDL_COMPUTERSNEARME }
*)
  end;

function CriarDir(aDir: string; aSlash: string = '\'):boolean;
  var
    vPath: string;
    vItem: string;
    vDrive: string;
    vCount: integer;
    i: integer;

    function criaDir(aItem: integer): boolean;
    var
      i: integer;
    begin
      vPath:='';
      vPath:=vDrive+':';
      {inicia no dois pois o primeiro item é None por causa do tratamento do
      GetItemFromStrComaSep}
      for i:= 2 to aItem+1 do
        if i< vCount+1 then//garante que não vai passar do final
        vPath:= vPath+aSlash+Util.GetItemFromStrComaSep(vItem,i,aSlash);
      if not DirectoryExists(vPath) then begin
        if not CreateDir(vPath) then
          result:= false else
          result:= true;
      end else result:= true;
    end;
  begin
    vDrive:= Util.GetItemFromStrComaSep(aDir,1,':');
    vItem:= Util.GetItemFromStrComaSep(aDir,2,':');
    vCount:= Util.ContItensFromStrComaSep(vItem,aSlash);
    for i:=1 to vCount do begin
      if not(CriaDir(i)) then begin
        result:= false;
        break;
      end;
    end;
  end;

function RemoverDir(aDir: string; aItensCountDown: integer = 1):boolean;
  var
    vPath: string;
    vItem: string;
    vDrive: string;
    vCount: integer;
    i: integer;

    function MyRemoveDir(aItems: integer): boolean;
    var
      i: integer;
      vInc: integer;
    begin
      result:= true;
      vInc:= 0;
      repeat
        vPath:='';
        vPath:=vDrive+':';
        for i:= 1 to vCount do
//          if i< vCount then
          vPath:= vPath+'\'+Util.GetItemFromStrComaSep(vItem,i,'\');
        if DirectoryExists(vPath) then
          if not RemoveDir(vPath) then begin
            result:= false;
            break;
          end;
        dec(vCount,1);
        inc(vInc);
      until vInc = aItems;
    end;
  begin
    vDrive:= Util.GetItemFromStrComaSep(aDir,1,':');
    vItem:= Util.GetItemFromStrComaSep(aDir,2,':');
    vCount:= Util.ContItensFromStrComaSep(vItem,'\');
    result:= MyRemoveDir(aItensCountDown);
  end;

{Procedimentos para LOG}
procedure LogRead(aLines:TStrings; aFileName: string = 'Log.log');
begin
  if fileExists(aFileName) then
  aLines.LoadFromFile(aFileName);
end;

procedure LogWrite(aLog: string; aLines: TStrings; aFileName: string = 'Log.Log'; aTipo: string = 'Exception');
var
  i: integer;
  vData: TDateTime;
  vDataStr: string;
  vHoraStr:string;
  vHeaderIndex: integer;
  vLine: string;
  vFileLog: TStrings;
  aa, mm, dd: Word;

  function FindHeaderIndex(aData: string): integer;
  var
    i: integer;
    vAux: string;
  begin
    result:=-1;
    for i:= 0 to vFileLog.Count-1 do begin
      vAux:= vFileLog.Strings[i];
      if Pos('['+aData,vAux) <> 0 then begin
        result:= i;
        break;
      end;
    end;
    if result = -1 then begin
      vFileLog.Insert(0,'['+aData+']');
      vFileLog.Add('');
      Result:=0;
    end else
    if result = vFileLog.Count-1 then
      vFileLog.Add('');
  end;
begin
  vFileLog := TStringList.Create;
  if FileExists(aFileName)
    then vFileLog.LoadFromFile(aFileName);

  vData:= now;
  DecodeDate(vData,aa,mm,dd);
//  vDataStr:= MyDateToStr(vData);
  vDataStr:= intToStr(dd)+'/'+intToStr(mm)+'/'+intToStr(aa);
  vHoraStr:= TimeToStr(vData);
  vHeaderIndex:= FindHeaderIndex(vDataStr);
  for i:= aLines.Count -1 downto 0 do
    vFileLog.Insert(vHeaderIndex+1,aLines.Strings[i]);

  //header
  vLine:= vHoraStr+'-'+ aTipo+ '='+aLog;
  vFileLog.Insert(vHeaderIndex+1, vLine);

  vFileLog.SaveToFile(aFileName);
  vFileLog.Free;
  FAppLogFile.Clear;
end;

procedure LogClear(aFileName: string);
var
  vTS: TStrings;
begin
  vTS:= TStringList.Create;
  vTs.SaveToFile(aFileName);
  vTS.Free;
end;

procedure LogGet(aFileName: string; aLines: TStrings);
var
  i: integer;
  vFile: TStrings;
begin
  if not fileExists(aFileName) then exit;
  vFile:= TStringList.Create;
  vFile.LoadFromFile(aFileName);
  i:=0;
  repeat
    aLines.Add(vFile.Strings[i]);
    inc(i);
    if (i > (vFile.Count-1)) then exit;
  until (pos('[',vFile.Strings[i]) >0) or (i > (vFile.Count-1));
end;

procedure logAddLine(aLine: string);
begin
  FAppLogFile.Add(aLine);
end;


  {Funções para compatibilidade com tradutor}
function GetLangStr(aBRStr: string; aLangFile: TStrings): string;
var
  i: integer;
  aAux: string;
  vBRItem,vLangItem: string;
begin
  result:='None';
  for i:= 0 to aLangFile.Count-1 do begin
    aAux:= aLangFile.Strings[i];
    if Pos('=',aAux) <> 0 then begin
      vBRItem:=GetItemFromStrComaSep(aAux,1,'=');
      vLangItem:=GetItemFromStrComaSep(aAux,2,'=');
      if vBRItem=aBRStr then begin
        result:= vLangItem;
        break;
      end;
    end;
  end;
end;

function GetBRAStr(aLangStr:string; aLangFile: TStrings): string;
var
  i: integer;
  aAux: string;
  vBRItem,vLangItem: string;
begin
  result:='None';
  for i:= 0 to aLangFile.Count-1 do begin
    aAux:= aLangFile.Strings[i];
    if Pos('=',aAux) <> 0 then begin
      vBRItem:=GetItemFromStrComaSep(aAux,1,'=');
      vLangItem:=GetItemFromStrComaSep(aAux,2,'=');
      if vLangItem= aLangStr then begin
        result:= vBRItem;
        break;
      end;
    end;
  end;
end;

{}
function GetUpdateInfo(aAppName: string; aLines: TStrings): string;
  var
    i: integer;
    vLine: string;
    vAppVersion: string;
  begin
    vAppVersion:='';
    for i:= 0 to aLines.Count-1 do begin
      vLine:= aLines.Strings[i];
      if pos(aAppName,vLine) <> 0 then begin
        vAppVersion:= Util.GetItemFromStrComaSep(vLine,2);
        vAppVersion:= copy(vAppVersion,pos(':',vAppVersion)+1,length(vAppVersion));
        vAppVersion:= vAppVersion+';'+Util.GetItemFromStrComaSep(vLine,3);
        break;
      end;
    end;
    result:= vAppVersion;
  end;

(*
  procedure setRootForBrowseFolder(aDir: string);
  begin
    if aDir = 'fdProgramFiles' then
      Self.Folders.rootDirectory:= fdProgramFiles;
    if aDir = 'fdProgramFilesCommon' then
      Self.Folders.rootDirectory:= fdProgramFilesCommon;

    if aDir = 'fdNoSpecialFolder' then
      Self.Folders.rootDirectory:= fdNoSpecialFolder;
    if aDir = 'fdRootFolder' then
      Self.Folders.rootDirectory:= fdRootFolder;
    if aDir = 'fdRecycleBin' then
      Self.Folders.rootDirectory:= fdRecycleBin;
    if aDir = 'fdControlPanel' then
      Self.Folders.rootDirectory:= fdControlPanel;
    if aDir = 'fdDesktop' then
      Self.Folders.rootDirectory:= fdDesktop;
    if aDir = 'fdDesktopDirectory' then
      Self.Folders.rootDirectory:= fdDesktopDirectory;
    if aDir = 'fdMyComputer' then
      Self.Folders.rootDirectory:= fdMyComputer;
    if aDir = 'fdFonts' then
      Self.Folders.rootDirectory:= fdFonts;
    if aDir = 'fdNetHood' then
      Self.Folders.rootDirectory:= fdNetHood;
    if aDir = 'fdNetwork' then
      Self.Folders.rootDirectory:= fdNetwork;
    if aDir = 'fdPersonal' then
      Self.Folders.rootDirectory:= fdPersonal;
    if aDir = 'fdPrinters' then
      Self.Folders.rootDirectory:= fdPrinters;
    if aDir = 'fdPrograms' then
      Self.Folders.rootDirectory:= ;
    if aDir = 'fdRecent' then
      Self.Folders.rootDirectory:= fdRecent;
    if aDir = 'fdSendTo' then
      Self.Folders.rootDirectory:= fdSendTo;

    fdStartMenu, { CSIDL_STARTMENU }
    fdStartup, { CSIDL_STARTUP }
    fdTemplates, { CSIDL_TEMPLATES }
    fdStartUpNonLocalized, { CSIDL_ALTSTARTUP }
    fdCommonStartUpNonLocalized, { CSIDL_COMMON_ALTSTARTUP }
    fdCommonDocuments, { CSIDL_COMMON_DOCUMENTS }
    fdCommonFavorites, { CSIDL_COMMON_FAVORITES }
    fdCommonPrograms, { CSIDL_COMMON_PROGRAMS }
    fdCommonStartUp, { CSIDL_COMMON_STARTUP }
    fdCommonTemplates, { CSIDL_COMMON_TEMPLATES }
    fdCookies, { CSIDL_COOKIES }
    fdFavorites, { CSIDL_FAVORITES }
    fdHistory, { CSIDL_HISTORY }
    fdInternet, { CSIDL_INTERNET }
    fdMyMusic, { CSIDL_MYMUSIC }
    fdPrinthood, { CSIDL_PRINTHOOD }
    fdConnections, { CSIDL_CONNECTIONS }

    { Version 4.71 }
    fdAppData, { CSIDL_APPDATA }

    { Version 4.72 }
    fdInternetCache, { CSIDL_INTERNET_CACHE }

    { Version 5.00 }
    fdAdminTools, { CSIDL_ADMINTOOLS }
    fdCommonAdminTools, { CSIDL_COMMON_ADMINTOOLS }
    fdCommonAppData, { CSIDL_COMMON_APPDATA }
    fdLocalAppData, { CSIDL_LOCAL_APPDATA }
    fdMyPictures, { CSIDL_MYPICTURES }
    fdProfile, { CSIDL_PROFILE }
    fdProgramFiles, { CSIDL_PROGRAM_FILES }
    fdProgramFilesCommon, { CSIDL_PROGRAM_FILES_COMMON }
    fdSystem, { CSIDL_SYSTEM }
    fdWindows, { CSIDL_WINDOWS }

    {  Version 6.00 }
    fdCDBurnArea, { CSIDL_CDBURN_AREA }
    fdCommonMusic, { CSIDL_COMMON_MUSIC }
    fdCommonPictures, { CSIDL_COMMON_PICTURES }
    fdCommonVideo, { CSIDL_COMMON_VIDEO }
    fdMyDocuments, { CSIDL_MYDOCUMENTS }
    fdMyVideo, { CSIDL_MYVIDEO }
    fdProfiles, { CSIDL_PROFILES }

    { Unknown version }
    fdResources, { CSIDL_RESOURCES }
    fdResourcesLocalized,
    fdCommonOEMLinks, { CSIDL_COMMON_OEM_LINKS }
    fdComputersNearMe { CSIDL_COMPUTERSNEARME }

  end;
*)
{--------------------------------------Inicio Tratamento de Lista de Inteiros}
Function ListIntIsIn(aValues: TArrayInt; aValue: integer): boolean;
var
  i: integer;
begin
  result:= false;
  for i:= low(aValues) to High(aValues) do
    if aValue = aValues[i] then begin
      result:= true;
      break;
    end;
end;

Function ListIntPos(aValues: TArrayInt; aValue: integer): Integer;
var
  i: integer;
begin
  result:= -1;
  for i:= low(aValues) to High(aValues) do
    if aValue = aValues[i] then begin
      result:= i;
      break;
    end;
end;

function ListIntAddPilha(var aValues: TArrayInt; aValue: integer; aLimite: integer;
                         var aIndex: integer; aFirst: boolean = false): boolean;
var
//  vCount: integer;
//  vTemp: integer;
  i: integer;
begin
  result:= true;
//  vCount:= high(aValues);
  if aIndex+1 <= aLimite then begin
      inc(aIndex);
      setLength(aValues,aIndex)
    end else begin
      result:= false;
      exit;//Pilha cheia
    end;
//  vCount:= high(aValues);
  if not(aFirst) then
    {Insere na última posição}
    aValues[high(aValues)]:= aValue
    else begin
      {Move itens uma casa para liberar a primeira, então insere o valor}
      for i:= High(aValues) Downto Low(aValues) do begin
        if i > low(aValues) then
          aValues[i]:= aValues[i-1] else
          aValues[i]:= aValue;
    end;
  end;
end;

procedure ListIntAddFIFO(var aValues: TArrayInt; aValue: integer; aLimite: integer; var aIndex: integer);
var
  i: integer;
begin
  if aIndex+1 <= aLimite then begin
    inc(aIndex);
    setLength(aValues,aIndex);
  end;
  {Move itens uma casa para liberar a primeira, então insere o valor}
  for i:= High(aValues) Downto Low(aValues) do
    if i > low(aValues) then
      aValues[i]:= aValues[i-1] else
      aValues[i]:= aValue;
end;

function ListIntIns(var aValues: TArrayInt; aValue: integer; var aIndex: integer;
                    aPos: integer = 0; aOverWrite: boolean = true;
                    aLimite: integer = -1): boolean;
var
//  vCount: integer;
//  vValues: TArrayStr;
  vIndex: integer;
  i: integer;
//  vTemp: integer;
begin
  result:= true;
//  vCount:= high(aValues);
  if aLimite = -1 then begin
      {Limite não foi definido, então a posição tem que estar
      no intervalo de vCount e OverWrite true}
      if not(aOverWrite) then begin result:= false; exit; end;
      if aPos > aIndex then begin result:= false; exit; end;
    end else begin
      {Limite foi definido, então}
      if not(aOverWrite) then begin
        {Define se pode inserir sem extrapolar o limite}
//        vCount:= high(aValues);
        {se a posição informada estiver fora do limite a ser definido}
        if aPos > aIndex+1 then begin result:= false; exit; end;
        if aIndex+1 < aLimite then begin
            inc(aIndex);
            setLength(aValues,aIndex)
          end else begin
            result:= false;
            exit;//limite extrapolado
          end;
//        vCount:= high(aValues);
      end;
    end;
  if aOverWrite then
    {Sobrescrever item na posição}
    aValues[aPos]:= aValue
    else begin
      {Inserir na posição final}
      if aPos = High(aValues) then begin
        aValues[High(aValues)]:= aValue;
        exit;
      end;
      {Inserir em uma posição da lista}
      for i:= High(aValues) Downto Low(aValues) do begin
        if i <> aPos then
          aValues[i]:= aValues[i-1]
          else begin
            aValues[i]:= aValue;
            break;
          end;
      end;
    end;
end;
{--------------------------------------Final Tratamento de Lista de inteiros}

{--------------------------------------Inicio Tratamento de Lista de Strings}
Function ListStrIsIn(aValues: TArrayStr; aValue: String): boolean;
var
  i: integer;
begin
  result:= false;
  for i:= low(aValues) to High(aValues) do
    if aValue = aValues[i] then begin
      result:= true;
      break;
    end;
end;

Function ListStrPos(aValues: TArrayStr; aValue: string): Integer;
var
  i: integer;
begin
  result:= -1;
  for i:= low(aValues) to High(aValues) do
    if aValue = aValues[i] then begin
      result:= i;
      break;
    end;
end;

function ListStrAddPilha(var aValues: TArrayStr; aValue: string; aLimite: integer;
                         var aIndex: integer; aFirst: boolean = false): boolean;
var
//  vCount: integer;
//  vTemp: integer;
  i: integer;
begin
  result:= true;
//  vCount:= high(aValues);
  if aIndex+1 <= aLimite then begin
      inc(aIndex);
      setLength(aValues,aIndex)
    end else begin
      result:= false;
      exit;//Pilha cheia
    end;
//  vCount:= high(aValues);
  if not(aFirst) then
    {Insere na última posição}
    aValues[high(aValues)]:= aValue
    else begin
      {Move itens uma casa para liberar a primeira, então insere o valor}
      for i:= High(aValues) Downto Low(aValues) do begin
        if i > low(aValues) then
          aValues[i]:= aValues[i-1] else
          aValues[i]:= aValue;
    end;
  end;
end;

procedure ListStrAddFIFO(var aValues: TArrayStr; aValue: string; aLimite: integer; var aIndex: integer);
var
  i: integer;
begin
  if aIndex+1 <= aLimite then begin
    inc(aIndex);
    setLength(aValues,aIndex);
  end;
  {Move itens uma casa para liberar a primeira, então insere o valor}
  for i:= High(aValues) Downto Low(aValues) do
    if i > low(aValues) then
      aValues[i]:= aValues[i-1] else
      aValues[i]:= aValue;
end;

function ListStrIns(var aValues: TArrayStr; aValue: String; var aIndex: integer;
                    aPos: integer = 0; aOverWrite: boolean = true;
                    aLimite: integer = -1): boolean;
var
//  vCount: integer;
//  vValues: TArrayStr;
  vIndex: integer;
  i: integer;
//  vTemp: integer;
begin
  result:= true;
//  vCount:= high(aValues);
  if aLimite = -1 then begin
      {Limite não foi definido, então a posição tem que estar
      no intervalo de vCount e OverWrite true}
      if not(aOverWrite) then begin result:= false; exit; end;
      if aPos > aIndex then begin result:= false; exit; end;
    end else begin
      {Limite foi definido, então}
      if not(aOverWrite) then begin
        {Define se pode inserir sem extrapolar o limite}
//        vCount:= high(aValues);
        {se a posição informada estiver fora do limite a ser definido}
        if aPos > aIndex+1 then begin result:= false; exit; end;
        if aIndex+1 < aLimite then begin
            inc(aIndex);
            setLength(aValues,aIndex)
          end else begin
            result:= false;
            exit;//limite extrapolado
          end;
//        vCount:= high(aValues);
      end;
    end;
  if aOverWrite then
    {Sobrescrever item na posição}
    aValues[aPos]:= aValue
    else begin
      {Inserir na posição final}
      if aPos = High(aValues) then begin
        aValues[High(aValues)]:= aValue;
        exit;
      end;
      {Inserir em uma posição da lista}
      for i:= High(aValues) Downto Low(aValues) do begin
        if i <> aPos then
          aValues[i]:= aValues[i-1]
          else begin
            aValues[i]:= aValue;
            break;
          end;
      end;
    end;
end;
{--------------------------------------Final Tratamento de Lista de Strings}
function BuscaBinaria (Vetor: TStringList;
                       aChave: string;
                       aPos, aMin, aMax: Integer;
                       aAnterior: string = 'None'
                       ): string;
begin
  result:='';
end;

function SetLimits(Vetor: TStringList;
                   aItem: string;
                   aPos, aMin, aMax: Integer;
                   aAnterior: string = 'None'
                   ): string;
begin
  result:='';

end;

function BuscaBinaria (Vetor: TStrings; Chave: string; aMax: integer): integer;overload;
          var inicio, fim: integer; {Auxiliares que representam o inicio e o fim do vetor analisado}
              meio: integer; {Meio do vetor}
begin
    fim := aMax; {O valor do último índice do vetor}
    inicio := 0; {O valor do primeiro índice do vetor}
    Result := -1; {Retorna o valor -1 se a chave nao for encontrada.}
      repeat
           meio := (inicio+fim) div 2;
           if (Chave = Vetor.Strings[meio]) then
           begin
                Result := meio;
                inicio:=fim+1; {Interrompo o repeat quando a chave for encontrada sem ter que testar lá no until. Bonito não?!}
           end;
           if (Chave < Vetor.Strings[meio]) then
                fim:=(meio-1);
           if (Chave > Vetor.Strings[meio]) then
                inicio:=(meio+1);
      until (inicio > fim);
end;

function GetZeros(aNumber: integer): Integer;
begin
  if aNumber <= 9 then result:= 1;
  if (aNumber  >= 10) and (aNumber <=                   99) then result:= 1;
  if (aNumber >= 100) and (aNumber <=                   999) then result:= 2;
  if (aNumber >= 1000) and (aNumber <=                  9999) then result:= 3;
  if (aNumber >= 10000) and (aNumber <=                 99999) then result:= 4;
  if (aNumber >= 100000) and (aNumber <=                999999) then result:= 5;
  if (aNumber >= 1000000) and (aNumber <=               9999999) then result:= 6;
  if (aNumber >= 10000000) and (aNumber <=              99999999) then result:= 7;
  if (aNumber >= 100000000) and (aNumber <=             999999999) then result:= 8;
  if (aNumber >= 1000000000) and (aNumber <=            9999999999) then result:= 9;
  if (aNumber >= 10000000000) and (aNumber <=           99999999999) then result:= 10;
  if (aNumber >= 100000000000) and (aNumber <=          999999999999) then result:= 11;
  if (aNumber >= 1000000000000) and (aNumber <=         9999999999999) then result:= 12;
  if (aNumber >= 10000000000000) and (aNumber <=        99999999999999) then result:= 13;
  if (aNumber >= 100000000000000) and (aNumber <=       999999999999999) then result:= 14;
  if (aNumber >= 1000000000000000) and (aNumber <=      9999999999999999) then result:= 15;
  if (aNumber >= 10000000000000000) and (aNumber <=     99999999999999999) then result:= 16;
  if (aNumber >= 100000000000000000) and (aNumber <=    999999999999999999) then result:= 17;
end;

function GetQuantDigit(aNumber: integer): Integer;
begin
  if aNumber <= 9 then result:= 1;
  if (aNumber  >= 10) and (aNumber <=                   99) then result:= 2;
  if (aNumber >= 100) and (aNumber <=                   999) then result:= 3;
  if (aNumber >= 1000) and (aNumber <=                  9999) then result:= 4;
  if (aNumber >= 10000) and (aNumber <=                 99999) then result:= 5;
  if (aNumber >= 100000) and (aNumber <=                999999) then result:= 6;
  if (aNumber >= 1000000) and (aNumber <=               9999999) then result:= 7;
  if (aNumber >= 10000000) and (aNumber <=              99999999) then result:= 8;
  if (aNumber >= 100000000) and (aNumber <=             999999999) then result:= 9;
  if (aNumber >= 1000000000) and (aNumber <=            9999999999) then result:= 10;
  if (aNumber >= 10000000000) and (aNumber <=           99999999999) then result:= 11;
  if (aNumber >= 100000000000) and (aNumber <=          999999999999) then result:= 12;
  if (aNumber >= 1000000000000) and (aNumber <=         9999999999999) then result:= 13;
  if (aNumber >= 10000000000000) and (aNumber <=        99999999999999) then result:= 14;
  if (aNumber >= 100000000000000) and (aNumber <=       999999999999999) then result:= 15;
  if (aNumber >= 1000000000000000) and (aNumber <=      9999999999999999) then result:= 16;
  if (aNumber >= 10000000000000000) and (aNumber <=     99999999999999999) then result:= 17;
  if (aNumber >= 100000000000000000) and (aNumber <=    999999999999999999) then result:= 18;
end;

function includeZeros(aNumber: string; aZeros: Integer = 1): string; overload;
var
  i: integer;
begin
  result:='';
  for i:= 0 to aZeros -1 do
    result:= Result + '0';
  result:= Result + aNumber;
end;

function includeZeros(aNumber: integer; aZeros: Integer = 1; aNone: string = ''): string; overload;
var
  i: integer;
begin
  result:='';
  for i:= 0 to aZeros -1 do
    result:= Result + '0';
  result:= Result + IntToStr(aNumber);
end;
{
Usage:
AddLeadingZeroes(2005, 10) ;

Will result in a '0000002005' string value.
}
function AddLeadingZeroes(const aNumber, Length : integer) : string;
begin
   result := SysUtils.Format('%.*d', [Length, aNumber]) ;
end;

{
Exemplo de utilização

}

function includeZerosToMax(aNumber: Integer; aMax: Integer): string;
var
  vZeros: Integer;
begin
  vZeros:= GetQuantDigit(aMax);
  result:= AddLeadingZeroes(aNumber, vZeros);
end;

function ReturnNumbers(aMask: string):string;
var
  vSep: string;
  vCountItens: integer;
  vItens: array of string;
  i: integer;

  function isComaSep(aStr: string): boolean;
  begin
    result:= pos(',',aStr) <> 0;
  end;
  function isHifenSep(aStr: string): boolean;
  begin
    result:= pos('-',aStr) <> 0;
  end;
  function getNumbersFromComaSep(aStr: string): string;
  var
    i: integer;
    vCount: integer;
    vNum: integer;
    vNumStr:string;
  begin
    result:='';
    vCount:= ContItensFromStrComaSep(aStr,',');
    for i:= 1 to vCount do begin
      vNumStr:=getItemFromStrComaSep(aStr,i,',');
      vNum:= StrToInt(vNumStr);
      if vNum < 10 then vNumStr:='0'+vNumStr;
      result:= result+ vNumStr +';';
    end;
  end;
  function getNumbersFromHifenSep(aStr: string): string;
  var
    i: integer;
    vIniStr, vFimStr: string;
    vIni, vFim: integer;
  begin
    result:='';
    vIniStr:= copy(aStr,1,pos('-',aStr)-1);
    vFimStr:= copy(aStr,pos('-',aStr)+1,length(aStr));
    vIni:= strToInt(vIniStr);
    vFim:= strToInt(vFimStr);
    for i:= vIni to vFim do begin
      if i < 10 then
      result:= result+ '0'+intToStr(i)+';' else
      result:= result+ intToStr(i)+';';
    end;
  end;
begin
  result:='';
  vCountItens:= contItensFromStrComaSep(aMask);
  setLength(vItens,vCountItens);
  for i:= low(vItens) to High(vItens) do begin
    vItens[i]:= getItemFromStrComaSep(aMask,i+1);
    if vItens[i] = '' then continue;
    if isComaSep(vItens[i]) then
      result:= result+GetNumbersFromComaSep(vItens[i]) else
      if not(isHifenSep(vItens[i])) then
        result:= result+ vItens[i]+';';
    if isHifenSep(vItens[i]) then
      result:= result+GetNumbersFromHifenSep(vItens[i]);
  end;
  if Result[length(result)]=';' then
    Result:= copy(Result,1,length(result)-1);
end;

function getMonthNumber(aMonth: string; aLang: TStrings): integer;
var
  vMonth: string;
  vItemBR: string;
begin
  result:=0;
  vMonth:= copy(aMonth,1,3);
  vItemBR:= GetBRAStr(aMonth,aLang);
  if (uppercase(vItemBR) = 'JAN') then result:=1;
  if (uppercase(vItemBR) = 'FEV') then result:=2;
  if (uppercase(vItemBR) = 'MAR') then result:=3;
  if (uppercase(vItemBR) = 'ABR') then result:=4;
  if (uppercase(vItemBR) = 'MAI') then result:=5;
  if (uppercase(vItemBR) = 'JUN') then result:=6;
  if (uppercase(vItemBR) = 'JUL') then result:=7;
  if (uppercase(vItemBR) = 'AGO') then result:=8;
  if (uppercase(vItemBR) = 'SET') then result:=9;
  if (uppercase(vItemBR) = 'OUT') then result:=10;
  if (uppercase(vItemBR) = 'NOV') then result:=11;
  if (uppercase(vItemBR) = 'DEZ') then result:=12;
end;

function getMonthName(aMonth: integer; aLang: TStrings = nil): string;
var
  vItemLang: string;
begin
  result:='None';
  case aMonth of
  1: vItemLang:=GetLangStr('Jan',aLang);
  2: vItemLang:=GetLangStr('Fev',aLang);
  3: vItemLang:=GetLangStr('Mar',aLang);
  4: vItemLang:=GetLangStr('Abr',aLang);
  5: vItemLang:=GetLangStr('Mai',aLang);
  6: vItemLang:=GetLangStr('Jun',aLang);
  7: vItemLang:=GetLangStr('Jul',aLang);
  8: vItemLang:=GetLangStr('Ago',aLang);
  9: vItemLang:=GetLangStr('Set',aLang);
  10: vItemLang:=GetLangStr('Out',aLang);
  11: vItemLang:=GetLangStr('Nov',aLang);
  12: vItemLang:=GetLangStr('Dez',aLang);
  end;
  result:= vItemLang;
end;

function ReturnMeses(aMask: string; aLang: TStrings):string;
var
  vSep: string;
  vCountItens: integer;
  vItens: array of string;
  i: integer;

  function isComaSep(aStr: string): boolean;
  begin
    result:= pos(',',aStr) <> 0;
  end;
  function isHifenSep(aStr: string): boolean;
  begin
    result:= pos('-',aStr) <> 0;
  end;
  function getMesesFromComaSep(aStr: string): string;
  var
    i: integer;
    vCount: integer;
    vTemp: string;
  begin
    result:='';
    vCount:= ContItensFromStrComaSep(aStr,',');
    for i:= 1 to vCount do begin
      vTemp:=getItemFromStrComaSep(aStr,i,',');
      vTemp:= copy(vTemp,1,3);
      result:= result+ vTemp+';';
    end;
  end;
  function getMesesFromHifenSep(aStr: string): string;
  var
    i: integer;
    vIniStr, vFimStr: string;
    vIni, vFim: integer;
  begin
    result:='';
    vIniStr:= copy(aStr,1,pos('-',aStr)-1);
    vFimStr:= copy(aStr,pos('-',aStr)+1,length(aStr));
    vIni:= getMonthNumber(vIniStr,aLang);
    vFim:= getMonthNumber(vFimStr,aLang);
    for i:= vIni to vFim do begin
      result:= result+ getMonthName(i,aLang)+';';
    end;
  end;
begin
  result:='';
  vCountItens:= contItensFromStrComaSep(aMask);
  setLength(vItens,vCountItens);
  for i:= low(vItens) to High(vItens) do begin
    vItens[i]:= getItemFromStrComaSep(aMask,i+1);
    if vItens[i] = '' then continue;
    if isComaSep(vItens[i]) then
      result:= result+GetMesesFromComaSep(vItens[i]) else
      if not(isHifenSep(vItens[i])) then
        result:= result+ vItens[i]+';';
    if isHifenSep(vItens[i]) then
      result:= result+GetMesesFromHifenSep(vItens[i]);
  end;
  if Result[length(result)]=';' then
    Result:= copy(Result,1,length(result)-1);
end;

function ReturnDatas(aMask: string):string;
var
  vSep: string;
  vCountItens: integer;
  vItens: array of string;
  i: integer;

  function isComaSep(aStr: string): boolean;
  begin
    result:= pos(',',aStr) <> 0;
  end;
  function isHifenSep(aStr: string): boolean;
  begin
    result:= pos('-',aStr) <> 0;
  end;
  function getDatasFromComaSep(aStr: string): string;
  var
    i: integer;
    vCount: integer;
    vTemp: string;
  begin
    result:='';
    vCount:= ContItensFromStrComaSep(aStr,',');
    for i:= 1 to vCount do begin
      vTemp:= getItemFromStrComaSep(aStr,i,',');
      vTemp:= ChangeSlash(vTemp,'/','_');
      result:= result+ vTemp+';';
    end;
  end;
  function getDatasFromHifenSep(aStr: string): string;
  var
    i: integer;
    vIniStr, vFimStr: string;
    vIni, vFim: integer;
    vDataIni,vDataFim: TDate;
  begin
    result:='';
    vIniStr:= copy(aStr,1,pos('-',aStr)-1);
    vFimStr:= copy(aStr,pos('-',aStr)+1,length(aStr));
    vDataIni:= StrToDate(vIniStr);
    vDataFim:= strToDate(vFimStr);
    vIni:= 1;
    vFim:= DaysBetween(vDataIni,vDataFim);
    result:= result+ ChangeSlash(vIniStr,'/','_')+';';
    for i:= vIni to vFim do begin
      vDataIni:= IncDay(vDataIni,1);
      vIniStr:= DateToStr(vDataIni);
      vIniStr:= changeSlash(vIniStr,'/','_');
      result:= result+ vIniStr+';';
    end;
  end;
begin
  result:='';
  vCountItens:= contItensFromStrComaSep(aMask);
  setLength(vItens,vCountItens);
  for i:= low(vItens) to High(vItens) do begin
    vItens[i]:= getItemFromStrComaSep(aMask,i+1);
    if vItens[i] = '' then continue;
    if isComaSep(vItens[i]) then
      result:= result+GetDatasFromComaSep(vItens[i]) else
      if not(isHifenSep(vItens[i])) then
        result:= result+ vItens[i]+';';
    if isHifenSep(vItens[i]) then
      result:= result+GetDatasFromHifenSep(vItens[i]);
  end;
  if Result[length(result)]=';' then
    Result:= copy(Result,1,length(result)-1);
end;

function ChangeSep(aStr: string; aOldSep, aNewSep: string): string;
var
  i: integer;
  vChar: string;
begin
  result:='';
  i:=1;
  while i <= length(aStr) do begin
    vChar:= aStr[i];
    if vChar = aOldSep then
      vChar:= aNewSep;
    result:= result + vChar;
    inc(i);
  end;
end;

function GetSep(aStr: string): string;
var
  i: integer;
  vChar: char;
begin
  i:=1;
  while i <= length(aStr) do begin
    vChar:= aStr[i];
    if vChar in [' ',';',',','|','#','$','&','\','/','<','>','-', chr(9)] then begin
      result:= vChar;
      break;
    end;
    inc(i);
  end;
end;

function ContItensFromStrComaSep(aStr:String; aSep: string = ';'): integer;
  var
    i: integer;
  begin
    if aStr = '' then begin result:=0; exit; end;
    result:=1;
    for i:= 1 to length(aStr) do begin
      if aStr[i] = aSep then begin
        inc(Result);
      end;
    end;
  end;

function GetItemFromStrComaSep(aStr: string; aIndex: integer; aSep: string = ';'): string;
var
  i: integer;
  vPos: integer;
  vAux: string;
  vIsItem: Boolean;
  vAchaItem: integer;
  vCount: integer;

begin
  result:='None';
  vPos:= Pos(aSep,aStr);
  if vPos = 0 then begin
    result:= aStr;
    exit;
  end else begin
    vCount:= ContItensFromStrComaSep(aStr,aSep);
    if aIndex > vCount then begin
//      result:= 'None';
      exit;
    end else begin
        {Aqui começa a busca}
        vIsItem:= false;
        vAchaItem:=1;
        vAux:='';
        for i:= 1 to length(aStr) do begin
          if aIndex = 1 then vIsItem:= true;//é o primeiro item o procurado
          if (aStr[i] = aSep) and
             not(vIsItem) then begin
            {incrementa contador de itens}
            inc(vAchaItem);
            if vAchaItem = aIndex then begin
              vIsItem:= true;//achou o item
              continue;//passa para o próximo char após aSep
            end;
          end;
          if vIsItem then begin
            if aStr[i] = aSep then begin
              if vAux = '' then vAux:= 'None';//para o caso de haver dois aSep em sequência
              break;//para cópia ao achar outro aSep
            end;
            vAux:= vAux+ aStr[i];
          end;
        end;//for
        result:= vAux;
      end;
  end;
end;

  {Hash}
procedure LeituraDeHash(aStg: TStringGrid; aLines: TStrings);
var
  i: integer;
  vPos: integer;
  j: integer;
begin
  j:=1;
  for i:= 0 to aLines.Count-1 do begin
    vPos:= MyStrCharPos(';',aLines[i]);
    aStg.Cells[0,j]:= copy(aLines[i],1,vPos-1);
    aStg.Cells[1,j]:= copy(aLines[i],vPos+1,length(aLines[i]));
    aStg.RowCount:= aStg.RowCount+1;
    inc(j);
  end;
  if aStg.Cells[0,aStg.RowCount-1] = '' then
    aStg.RowCount:= aStg.RowCount-1;
end;

procedure CriarRomanos(aFPath,aFFile: string);
const
  cI = 'Um';
  cII = 'Dois';
var
  i: integer;
  aNStr: string;
  aStrings: TStrings;
    vLine: string;

  function StrToRoman(aStr: string): string;
  var
    i,j: integer;
    vCharNum: integer;

    vRUnidade,
    vRDezena,
    vRCentena,
    vRMilhar: string;

    vRomano: string;
  begin
    j:=1;
    for i:= length(aStr) Downto 1 do begin
      vCharNum:= strToInt(aStr[i]);
      case vCharNum of
       0: begin
         case j of
         1: vRUnidade:='';
         2: vRDezena:='';
         3: vRCentena:='';
         4: vRMilhar:='';
         end;
        end;
       1: begin //vCharNum é Um
         case j of //está na casa das
         1: begin                   //unidades
            vRUnidade:= 'I';
           end;
         2: begin                   //Dezenas
            vRDezena:='X';
           end;
         3: begin                   //Centenas
            vRCentena:= 'C';
           end;
         4: begin                  //Milhar
              vRMilhar:='M';
           end;
         end;
        end;
       2: begin //vCharNum é 2
         case j of
         1: begin  //o 2 está na casa das unidades
           vRUnidade:='II';
           end;
         2: begin
           vRDezena:='XX';
           end;
         3: begin
           vRCentena:='CC';
           end;
         4: begin
           vRMilhar:='MM';
           end;
         end;
        end;
       3: begin //vCharNum é 3
         case j of
         1: begin
           vRUnidade:='III';
           end;
         2: begin
           vRDezena:='XXX';
           end;
         3: begin
           vRCentena:='CCC';
           end;
         4: begin
           vRMilhar:='MMM';
           end;
         end;
        end;
       4: begin //vCharNum
         case j of
         1: begin
           vRUnidade:='IV';
           end;
         2: begin
           vRDezena:='XL';
           end;
         3: begin
           vRCentena:='CD';
           end;
         4: begin
           vRMilhar:='None';
           end;
         end;
        end;
       5: begin //vCharNum
         case j of
         1: begin
           vRUnidade:='V';
           end;
         2: begin
           vRDezena:='L';
           end;
         3: begin
           vRCentena:='D';
           end;
         4: begin
           vRMilhar:='None';
           end;
         end;
        end;
       6: begin  //vCharNum
         case j of
         1: begin
           vRUnidade:='VI';
           end;
         2: begin
           vRDezena:='LX';
           end;
         3: begin
           vRCentena:='DC';
           end;
         4: begin
           vRMilhar:='';
           end;
         end;
        end;
       7: begin //vCharNum
         case j of
         1: begin
           vRUnidade:='VII';
           end;
         2: begin
           vRDezena:='LXX';
           end;
         3: begin
           vRCentena:='DCC';
           end;
         4: begin
           vRMilhar:='';
           end;
         end;
        end;
       8: begin //vCharNum
         case j of
         1: begin
           vRUnidade:='VIII';
           end;
         2: begin
           vRDezena:='LXXX';
           end;
         3: begin
           vRCentena:='DCCC';
           end;
         4: begin
           vRMilhar:='';
           end;
         end;
        end;
       9: begin //vCharNum
         case j of
         1: begin
           vRUnidade:='IX';
           end;
         2: begin
           vRDezena:='XC';
           end;
         3: begin
           vRCentena:='CM';
           end;
         4: begin
           vRMilhar:='None';
           end;
         end;
        end;
      end;//case
      inc(j);
    end;//for
    Result:= vRMilhar+vRCentena+vRDezena+vRUnidade;
  end;
begin
  aStrings:= TStringList.Create;
  for i:= 1 to 1000 do begin
    aNStr:= IntToStr(i);
    vLine:= StrToRoman(aNStr);
    vLine:= vLine +';'+ Extenso(i);
    aStrings.Add(vLine);
  end;
  aStrings.SaveToFile(aFPath+aFFile);
end;

function getIPFromNetRes(text: string): string;
var
  myIP,sep: string;
  indexIni,IndexFim: integer;
begin
  myIP:= Text;
  sep:='(';
  IndexIni:= ansiPos(sep,myIP);
  if IndexIni = 0 then begin result:='No IP'; exit; end;
  sep:=')';
  IndexFim:= ansiPos(sep,myIP);
  myIP:= copy(myIP,IndexIni+1,IndexFim-IndexIni-1);
  result:= myIP;
end;

function getNameFromNetRes(text: string): string;
var
  myIP,sep: string;
  indexIni,IndexFim: integer;
begin
  result:= 'None';
  myIP:= Text;
  sep:='(';
  IndexIni:= ansiPos(sep,myIP);
  if IndexIni <> 0 then begin
    result:= myIP;
  end;
end;

function getNameMachineFromNetRes(text: string): string;
var
  myIP,sep: string;
  indexIni,IndexFim: integer;
begin
  result:= 'None';
  myIP:= Text;
  sep:='(';
  IndexIni:= ansiPos(sep,myIP);
  if IndexIni <> 0 then begin
    result:= copy(myIP,1,IndexIni-2);
    result:= myTrim(Result);
  end;
end;

function RemoveDiskFromPath(aPath: string): string;
var
  vPos: integer;
begin
  vPos:= myStrCharPos(':',aPath);
  result:= copy(aPath,vPos+1,length(aPath));
end;

function RemoveDiskPointFromPath(aPath: string): string;
var
  vPos: integer;
begin
  vPos:= myStrCharPos(':',aPath);
  result:= copy(aPath,1,vPos-1)+ copy(aPath,vPos+1,length(aPath));
end;

function compactPath(pPath: string; pLength: integer): string;
const
  cRet = '... ...';
var
  vPathIni,vPathFim: integer;
  vStrPathIni,vStrPathFim: string;
  vPathFinal: integer;
begin
  result:='';
  vPathIni:= (pLength div 2) -4;
  vPathFim:= (pLength div 2) -3;

  vPathFinal:= length(pPath) - vPathFim;

  if Length(pPath) > pLength then begin
    vStrPathIni:= copy(pPath,1,vPathIni);
    vStrPathFim:= copy(pPath,vPathFinal,Length(pPath));//-vPathFinal);

    result:= vStrPathIni+cRet+vStrPathFim;
  end else result:= pPath;
end;

  {  Funções Genéricas  }

{
Exemplos
 Util.jumpTo(self.Handle,'www.jles.net','www');
  Util.jumpTo(self.Handle,'mailto:sugestoes@jles.net','eMail');
}
procedure jumpTo(aHWND:hwnd; aComando,aTipo:string; aDir: string = '');
{var AHost: String; //SMTP server used to send the message.
    ASubject: String; //Subject of the message.
    ATo: String;  //Recipient(s) of the message.
    AFrom: String;  //Person sending the message.
    AText: String;  //Body text for the message.
}
var
  vParam: string;
begin
  vParam:=chr(39)+aTipo+chr(39);
  if aTipo <> '' then begin
   if aDir <> '' then
   ShellExecute(aHWND,'Open',pchar(aComando),pchar(vParam),pchar(aDir),sw_shownormal) else
   ShellExecute(aHWND,'open',pchar(aComando),pchar(vParam),nil,sw_shownormal);
  end else
   ShellExecute(aHWND,'open',pchar(aComando),nil,nil,sw_shownormal);
{  if uppercase(tipo) = 'MAIL'
     then begin
          end
     else begin
            ShellExecute(h,'open',pchar(comando),nil,nil,sw_shownormal);
          end;
}
end;

{
Exemplo
  jumpToII(Self.Handle,'c:\windows\explorer.exe','MegaConf.chm',IncluirSlash(FAppPath));
}
procedure jumpToII(aHWND:hwnd; aProgram:string; aParam:string; aLocation: string = ''; aAction:string= 'Open');
//var
//  zOperation: array[0..79] of Char;
//  zFileName: array[0..MAX_PATH] of Char;  //870
//  zParams: array[0..79] of Char;
//  zDir: array[0..MAX_PATH] of Char;       //870
begin
//  ShellExecute(aHWND,
//    StrPCopy(zOperation, aAction),
//    StrPCopy(zFileName, aProgram),
//    StrPCopy(zParams, aParam),
//    StrPCopy(zDir, aLocation), SW_SHOW);
  if aParam <> '' then begin
   if aLocation <> '' then
   ShellExecute(aHWND,pchar(aAction),pchar(aProgram),pchar(aParam),pchar(aLocation),sw_show) else
   ShellExecute(aHWND,pchar(aAction),pchar(aProgram),pchar(aParam),nil,sw_show);
  end else
   ShellExecute(aHWND,pchar(aAction),pchar(aProgram),nil,nil,sw_show);
end;

//procedure CriarAtalhoDaNet(const NomeDoArquivo, URL : string);
//begin
////Pega o Diretório do Desktop Depois ele faz uma junção com o nome do arquivo e finalmente coloca a extensão, que é .URL
//with TIniFile.Create(DesktopDir+NomeDoArquivo+'.url') do
//try
////Escrevendo a URL do Atalho
//WriteString('InternetShortcut','URL',URL);
//
////Extraindo Ícone de um Executável, neste caso do EXE do Internet Explorer
//WriteString('InternetShortcut','IconFile',
//'C:\Arquivos de programas\Internet Explorer\iexplore.exe');
//
////Colocando o ìndice do ícone, porque o executavel possui mais de um Ícone
////Você pode alterar o valor para 1,3,4 ...
//WriteString('InternetShortcut','IconIndex','9');
//finally
//Free;
//end;
//end;

procedure mensagemDeDesconexao(aSnlConnected: boolean);
begin
  if not(asnlConnected) then
    begin
      showMessage('Não conectado ao banco de dados');
      exit;
    end;
end;

Function achaNumStr(b:string):Byte;
var i:Byte;
    c:char;
begin
  for i:= 0 to 255 do
  begin
      c:=chr(i);
      if b[1] = c
        then begin
              achaNumStr:=i;
              exit
             end;
  end;
  achaNumStr:=39;
end;

Function achaStrNum(b,f:byte):string;
begin
  achaStrNum:=chr(b+f);
end;

function ZeraVetStr2xX(const max: integer):TvetStrIII;
(* Limpa um vetor 2 x X, onde X é determinado pela constante passada
como parâmetro.
*)
var i,j:integer;
begin
  for i:= 1 to 2 do
    for j:=1 to max do Result[i,j]:='';
end;

Function LimpaStr(VStr:string):string;
var i,tam:integer;
    c:string;
    caux:char;
begin
 tam:=Length(VStr);
 c:='';
 for i:= 1 to tam do
 begin
    caux:= VStr[i];
    if (caux in ['a'..'z']) or (caux in ['A'..'Z'])
       then c:= c+ caux;
 end;
 LimpaStr:=c;
end;

function myTrim(aString: String; LimpaINI: boolean = true; LimpaFim: boolean = true):string;
var
  i: integer;
  vPos: integer;
  aux: string;
begin
  result:= aString;
  if aString = '' then exit;
  if LimpaIni then begin
    vPos:=1;
    {acha todos os brancos do início e indica a posição do primeiro caracter}
    for i:= 1 to length(aString) do
     if aString[i] = chr(20) then
       continue
     else
       begin
         vPos:= i;
         break;
       end;
    {Elimina os brancos do início}
    aux:= copy(aString,vPos,length(aString));
    Result:= aux;
  end;
  if LimpaFim then begin
    {acha todos os brancos do fim e indica a posição do último caracter}
    vPos:= Length(aux);
    for i:= length(aux) downto 1 do
     if aString[i] = chr(20) then
       continue
     else
       begin
         vPos:= i;
         break;
       end;
    {Elimina os brancos do final}
    result:= copy(aux,1,vPos);
  end;
end;

function retornaPonto(ffloat:string):string;
var i: integer;
    newvar:string;
begin
  //
  if ffloat = '' then ffloat:='0.0';
  newvar:='';
  for i:= 1 to length(ffloat) do
  begin
     if ffloat[i]=',' then
       newvar:=newvar + '.'
     else
       begin
         if ffloat[i]='.'
            then newvar:=newvar + ','
            else newvar:=newvar + ffloat[i];
       end
  end;
  retornaPonto:=newvar;
end;

  {  Funções avançadas  }
function HasProperty(aComponent: TComponent; aPropertyName: String): boolean;
var
  propInfo: PPropInfo;
begin
  PropInfo := GetPropInfo(aComponent.ClassInfo, aPropertyName);
  Result:= PropInfo <> nil;
end;

procedure SetIntegerPropertyIfExists(AComp: TComponent; APropName: String;
  AValue: Integer);
var
  PropInfo: PPropInfo;
begin
  PropInfo := GetPropInfo(AComp.ClassInfo, APropName);
  if PropInfo <> nil then
  begin
    if PropInfo^.PropType^.Kind = tkInteger then
      SetOrdProp(AComp, PropInfo, AValue);
  end;
end;

procedure SetObjectPropertyIfExists(AComponent: TComponent; APropName: String;
  AValue: TObject);
var
  PropInfo: PPropInfo;
begin
  PropInfo := GetPropInfo(AComponent.ClassInfo, APropName);
  if PropInfo <> nil then
  begin
    if PropInfo^.PropType^.Kind = tkClass then
      SetObjectProp(AComponent, PropInfo, AValue);
  end;
end;

procedure SetBooleanPropertyIfExists(AComp: TComponent; APropName: String;
  AValue: Boolean);
var
  PropInfo: PPropInfo;
begin
  PropInfo := GetPropInfo(AComp.ClassInfo, APropName);
  if PropInfo <> nil then
  begin
    if PropInfo^.PropType^.Kind = tkEnumeration then
      SetOrdProp(AComp, PropInfo, Integer(AValue));
  end;
end;

procedure SetStringPropertyIfExists(AComp: TComponent; APropName: String;
  AValue: String);
var
  PropInfo: PPropInfo;
  TK: TTypeKind;
begin
  PropInfo := GetPropInfo(AComp.ClassInfo, APropName);
  if PropInfo <> nil then
  begin
    TK := PropInfo^.PropType^.Kind;
    if (TK = tkString) or (TK = tkLString) or (TK = tkWString) then
      SetStrProp(AComp, PropInfo, AValue);
  end;
end;

(*
procedure SetPropertyIfExists(AComp: TComponent; APropName: String;
  AValue: Variant);
var
  PropInfo: PPropInfo;
  TK: TTypeKind;
begin
  PropInfo := GetPropInfo(AComp.ClassInfo, APropName);
  if PropInfo <> nil then
  begin
    TK := PropInfo^.PropType^.Kind;
    case TK of
    tkUnknown:;
    tkInteger:
      SetStrProp(AComp, PropInfo, Integer(AValue));
    tkChar:
      SetStrProp(AComp, PropInfo, Char(AValue));
    tkEnumeration:
      SetOrdProp(AComp, PropInfo, Integer(AValue));
    tkFloat:
      SetStrProp(AComp, PropInfo, Float(AValue));

    tkString,
    tkLString,
    tkWString:
      SetStrProp(AComp, PropInfo, String(AValue));
//    tkSet
//    tkClass
//    tkMethod
//    tkWChar:;
    tkVariant:
      SetStrProp(AComp, PropInfo, AValue);
//    tkArray
//    tkRecord
//    tkInterface
    tkInt64:
      SetStrProp(AComp, PropInfo, Int64(AValue));
//    tkDynArray
//    tkUString:;
//    tkClassRef
//    tkPointer
//    tkProcedure
    end;
  end;
end;

*)
procedure SetMethodPropertyIfExists(AComp: TComponent; APropName: String;
  AMethod: TMethod);
var
  PropInfo: PPropInfo;
begin
  PropInfo := GetPropInfo(AComp.ClassInfo, APropName);
  if PropInfo <> nil then
  begin
    if PropInfo^.PropType^.Kind = tkMethod then
      SetMethodProp(AComp, PropInfo, AMethod);
  end;
end;

  {  Funções de Tree  }
Function InserirNo(Tree:TTreeView; parent:TTreeNode; Tipo:TTipoNo; Texto:string; IMIndex,IStatIndex,ISelIndex:integer):TTreeNode; overload;
begin
//  InserirNo:=nil;
  if Tipo = iAdd
     then InserirNo:= Tree.Items.Add(Parent,texto)
     else  if Tipo = iAddC
              then InserirNo:= Tree.Items.AddChild(parent,Texto)
              else  if Tipo = iAddCF
                       then InserirNo:= Tree.Items.AddChildFirst(Parent,texto)
                       else InserirNo:=nil;
  InserirNo.ImageIndex:=IMIndex;
  InserirNo.StateIndex:=IStatIndex;
  InserirNo.SelectedIndex:=ISelIndex;
end;

Function InserirNo(Tree:TTreeView; parent:TTreeNode; Tipo:TTipoNo; Texto:string; IMIndex:integer):TTreeNode; overload;
begin
//  InserirNo:=nil;
  if Tipo = iAdd
     then InserirNo:= Tree.Items.Add(Parent,texto)
     else  if Tipo = iAddC
              then InserirNo:= Tree.Items.AddChild(parent,Texto)
              else  if Tipo = iAddCF
                       then InserirNo:= Tree.Items.AddChildFirst(Parent,texto)
                       else InserirNo:=nil;
  InserirNo.ImageIndex:=IMIndex + 1;
  InserirNo.SelectedIndex:=IMIndex;
end;

procedure CopyTree(aTreeFrom: TTreeView; aTreeTo: TTreeView; aNodeFrom,aNodeTo: TTreeNode);
var
  vNoRootTo,
  vNoRootFrom,
  vNoRootFromNext,
  vNoRootToSib
               : TTreeNode;

begin
//  if aNodeTo
  if aNodeTo <> nil then
    vNoRootTo:= aNodeTo else begin
    vNoRootTo:= InserirNo(aTreeTo,aNodeTo,iAddC,aNodeFrom.Text,aNodeFrom.ImageIndex);
    vNoRootTo.Data:= aNodeFrom.Data;
  end;
  vNoRootFrom:= aNodeFrom;
  if vNoRootFrom = nil then exit;
  Repeat
    {Inserindo nó no destino}
    if aNodeTo = nil then
    vNoRootToSib:= vNoRootTo else
    vNoRootToSib:= InserirNo(aTreeTo,vNoRootTo,iAddC,vNoRootFrom.Text,vNoRootFrom.ImageIndex);
    vNoRootToSib.Data:= vNoRootFrom.Data;

    {Pegando filhos}
      if vNoRootFrom.HasChildren then begin
        vNoRootFromNext:=vNoRootFrom.getFirstChild;
        CopyTree(aTreeFrom,aTreeTo,vNoRootFromNext,vNoRootToSib);
      end;

    {Pegando proximo}
    vNoRootFrom:=vNoRootFrom.getNextSibling;
  Until vNoRootFrom = nil;
end;

{  Funções de String Grids}
//leitura do registro INI do banco de dados
function GetRegisterBD(aBDName: string; aTree: TTreeView;
         aBarParcial: TProgressBar = nil; aBarTotal: TProgressBar = nil): boolean;
var
  vIni: TIniFile;
  ServerNode,BDNode,
  TBNode,CmpNode,
  otherNode: TTreeNode;
  vSection: string;
  i,j: integer;
  vAux: string;
  vQtdTB,vQtdCmp: integer;

  vCmpName,vCmpTipo,vCmpTamStr,vCmpNull: string;
  vUseBarParcial,
  vUseBarTotal: boolean;
begin
  { Progress Bar  }
  aTree.Items.Clear; 
  if aBarParcial <> nil then
    begin
      vUseBarParcial:= true;
      aBarParcial.Visible:= true;
    end
  else
    begin
    vUseBarParcial:= false;
    aBarParcial.Visible:=false;
    end;
  if aBarTotal <> nil then
    vUseBarTotal:= true
  else
    vUseBarTotal:= false;

  vIni:= TIniFile.Create(aBDName+'.ini');
  vSection:= aBDName+'-Struct';
  vAux:= vIni.ReadString(vSection,'BDServer','');
    ServerNode:= InserirNo(aTree,nil,iadd,vAux,0);
  vAux:= vIni.ReadString(vSection,'BDName','');
    BDNode:= InserirNo(aTree,ServerNode,iAddC,vAux,0);
  vQtdTB:= vIni.ReadInteger(vSection,'QtdTabelas',0);

  application.processMessages;

  { Progress Bar  }
  if vUseBarTotal then aBarTotal.Max:= vQtdTB;

  for i:= 1 to vQtdTB do
  begin
    vSection:= aBDName+'-Tabelas';
    vAux:= vIni.ReadString(vSection,'TBName'+intToStr(i),'');
    if vAux = '' then continue;
    vQtdCmp:= vIni.ReadInteger(vSection,'QtdCmp'+intToStr(i),0);
      TBNode:= InserirNo(aTree,BDNode,iAddC,vAux,0);

    { Progress Bar  }
    if vUseBarTotal then aBarTotal.Position:= i;
    application.processMessages;
    if vUseBarParcial then aBarParcial.Max:=vQtdCmp;

    for j:= 1 to vQtdCmp do
    begin
      vSection:= aBDName+'-'+vAux+'-campo'+intToStr(j);
      vCmpName:= vIni.ReadString(vSection,'cmpName','');
      vCmpTipo:= vIni.ReadString(vSection,'cmpTipo','');
      vCmpTamStr:= vIni.ReadString(vSection,'cmpTam','-1');
      vCmpNull:= vIni.ReadString(vSection,'cmpNull','');
        CmpNode:= InserirNo(aTree,TBNode,iAddC,vCmpName,0);
        InserirNo(aTree,CmpNode,iAddC,vCmpTipo,0);
        InserirNo(aTree,CmpNode,iAddC,vCmpTamStr,0);
        InserirNo(aTree,CmpNode,iAddC,vCmpNull,0);

      { Progress Bar  }
      if vUseBarParcial then aBarParcial.Position:=j;

      application.processMessages;
    end;
  end;
  vIni.Free;
  { Progress Bar  }
  if vUseBarTotal then aBarTotal.Position:=0;
  if vUseBarParcial then aBarParcial.Position:=0;
  Result:= true;
end;

//Registro em INI da strutura do banco de dados
function RegisterBD(aServer, aPath: string; aGrid: TStringGrid;
         aBarParcial: TProgressBar = nil; aBarTotal: TProgressBar = nil): boolean;
const
  cBD = 0;
  cTB = 1;
  cCmp = 2;
  cTipo = 3;
  cTam = 4;
  cNull = 5;
var
  i: integer;
  vIni: TIniFile;
  vBD: string;
  vFinal: integer;

  vTBAtu,vTBAnt: string;
  vContTb: integer;

  vCmpAtu,vTipo,vTam,vNull: string;
  vContCmp: integer;

  vSection: string;
  vUseBarParcial,
  vUseBarTotal: boolean;
begin
  { Progress Bar  }
  if aBarParcial <> nil then
    begin
      vUseBarParcial:= true;
      aBarParcial.Visible:= true;
    end
  else
    begin
    vUseBarParcial:= false;
    aBarParcial.Visible:=false;
    end;
  if aBarTotal <> nil then
    vUseBarTotal:= true
  else
    vUseBarTotal:= false;

  vBD:= aGrid.Cells[cBD,1];
  vIni:= TIniFile.Create(vBD+'.ini');
  vFinal:= aGrid.RowCount -1;
  vTBAtu:='';
  vTBAnt:='';
  vContTb:=0;
  vContCMP:=0;
  vCmpAtu:='';

  { Progress Bar  }
  if vUseBarTotal then aBarTotal.Max:= vFinal;
  if vUseBarParcial then aBarParcial.Visible:=false;

  for i:=1 to vFinal do
  begin

    { Progress Bar  }
    if vUseBarTotal then aBarTotal.Position:=i;

    application.ProcessMessages;
    vTBAtu:= aGrid.Cells[cTB,i];
    if vTBAtu = '' then continue;
    if vTBAtu <> vTBAnt then
      begin
        //inc tb count zera cmp count RegistrarTB
        if vTBAnt <> '' then
          begin
            inc(vContTB);
            vSection:= vBD+'-Tabelas';
            vIni.WriteString(vSection,'TBName'+intToStr(vContTB),vTBAnt);
            vIni.WriteInteger(vSection,'QtdCmp'+intToStr(vContTB),vContCMP);
          end;
        vTBAnt:= vTBAtu;
        vContCmp:=0;
      end;
    inc(vContCmp);
    vCmpAtu:= aGrid.Cells[cCmp,i];
    vTipo:= aGrid.Cells[cTipo,i];
    vTam:= aGrid.Cells[cTam,i];
    vNull:= aGrid.Cells[cNull,i];
    vSection:= vBD+'-'+trim(vTBAtu)+'-campo'+intToStr(vContCmp);
    vIni.WriteString(vSection,'cmpName',vCmpAtu);
    vIni.WriteString(vSection,'cmpTipo',vTipo);
    if uppercase(vTam) <> 'IGNORE' then
      vIni.WriteString(vSection,'cmpTam',vTam)
    else
      vIni.WriteString(vSection,'cmpTam','-1');
    vIni.WriteString(vSection,'cmpNull',vNull);
  end;
  //Registrar BD Struct
  vSection:=vBD+'-Struct';
  vIni.WriteString(vSection,'BDServer',aServer);
  vIni.WriteString(vSection,'BDPath',aPath);
  vIni.WriteString(vSection,'BDName',vBD);
  vIni.WriteInteger(vSection,'QtdTabelas',vContTB);
  vIni.Free;

  { Progress Bar  }
  if vUseBarTotal then aBarTotal.Position:= 0;
end;

procedure setStgCabecalho(aGrid: TStringGrid; aNomes: string; aSep: string = ',');
var
  i: integer;
  vNomes, vAux: string;
  vIndex: integer;
begin
  vNomes:= aNomes +aSep;
  vAux:='';
  vIndex:=0;
  for i:= 1 to length(vNomes) do
  if vNomes[i] <> aSep then
    vAux:= vAux + vNomes[i]
  else
    begin
      aGrid.cells[vIndex,0]:=vAux;
      vAux:='';
      inc(vIndex);
    end;
end;

procedure LimpaGrid(aGrid: TStringGrid);
var
  i,j: integer;
begin
  for i:=1 to AGrid.RowCount -1 do
   for j:= 0 to AGrid.ColCount -1 do
     aGrid.Cells[j,i]:='';
  aGrid.RowCount:= 2;
end;

procedure PreencheDown(aCol,lIni,lFim: integer; aValue: string; aGrid: TStringGrid);
var
  i: integer;
begin
  for i:= lIni to LFim do
    aGrid.Cells[aCol,i]:= aValue;
end;

procedure PreencheUP(aCol,lIni,lFim: integer; aValue: string; aGrid: TStringGrid);
var
  i: integer;
begin
  for i:= LFim Downto lIni do
    aGrid.Cells[aCol,i]:= aValue;
end;

procedure PreencheRight(aColIni,aColFim,aLinha: integer; aValue: string; aGrid: TStringGrid);
var
  i: integer;
begin
  for i:= aColIni to aColFim do
    aGrid.Cells[i,aLinha]:= aValue;
end;

procedure PreencheLeft(aColIni,aColFim,aLinha: integer; aValue: string; aGrid: TStringGrid);
var
  i: integer;
begin
  for i:= aColFim Downto aColIni do
    aGrid.Cells[i,aLinha]:= aValue;
end;

//INC
procedure IncDown(aCol,lIni,lFim: integer; aValue: string; aGrid: TStringGrid);
var
  i: integer;
  vIncStr: string;
  vIncInt: integer;
  podeInc: boolean;
begin
  try
    vIncInt:= StrToInt(aValue);
    podeInc:= true;
  except
    podeInc:= false;
  end;
  for i:= lIni to LFim do
    if podeInc then
      begin
        vIncStr:= intToStr(vIncInt);
        aGrid.Cells[aCol,i]:= vIncStr;
        inc(vIncInt);
      end
    else
      aGrid.Cells[aCol,i]:= aValue;
end;

procedure IncUP(aCol,lIni,lFim: integer; aValue: string; aGrid: TStringGrid);
var
  i: integer;
  vIncStr: string;
  vIncInt: integer;
  podeInc: boolean;
begin
  try
    vIncInt:= StrToInt(aValue);
    podeInc:= true;
  except
    podeInc:= false;
  end;
  for i:= LFim Downto lIni do
    if podeInc then
      begin
        vIncStr:= intToStr(vIncInt);
        aGrid.Cells[aCol,i]:= vIncStr;
        inc(vIncInt);
      end
    else
      aGrid.Cells[aCol,i]:= aValue;
end;

procedure IncRight(aColIni,aColFim,aLinha: integer; aValue: string; aGrid: TStringGrid);
var
  i: integer;
  vIncStr: string;
  vIncInt: integer;
  podeInc: boolean;
begin
  try
    vIncInt:= StrToInt(aValue);
    podeInc:= true;
  except
    podeInc:= false;
  end;
  for i:= aColIni to aColFim do
    if podeInc then
      begin
        vIncStr:= intToStr(vIncInt);
        aGrid.Cells[i,aLinha]:= vIncStr;
        inc(vIncInt);
      end
    else
      aGrid.Cells[i,aLinha]:= aValue;
end;

procedure IncLeft(aColIni,aColFim,aLinha: integer; aValue: string; aGrid: TStringGrid);
var
  i: integer;
  vIncStr: string;
  vIncInt: integer;
  podeInc: boolean;
begin
  try
    vIncInt:= StrToInt(aValue);
    podeInc:= true;
  except
    podeInc:= false;
  end;
  for i:= aColFim Downto aColIni do
    if podeInc then
      begin
        vIncStr:= intToStr(vIncInt);
        aGrid.Cells[i,aLinha]:= vIncStr;
        inc(vIncInt);
      end
    else
      aGrid.Cells[i,aLinha]:= aValue;
end;

procedure PreencheGrid(aLIni,aLFim,aCIni,aCFim: integer;
         aGrid: TStringGrid; aValue: string = '');
var
  i,j: integer;
begin
  for i:= aLIni to aLFim do
   for j:= aCIni to aCFim do
     aGrid.Cells[j,i]:=aValue;
end;

function SomaSelGrid(aLIni,aLFim,aCIni,aCFim: integer;
         aGrid: TStringGrid): string;
var
  i,j: integer;
  soma: real;
  intStr: string;
  intInt: Real;
begin
  result:='0';
  soma:=0;
  for i:= aLIni to aLFim do
   for j:= aCIni to aCFim do
   try
     intStr:= aGrid.Cells[j,i];
     intInt:= StrToFloat(intStr);
     soma:= soma + intInt;
   except
     continue;
   end;
  result:= FloatToStr(Soma);
end;

//Deve ser um método
procedure stgKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState; aGrid: TStringGrid; aValue: string = '');
var
  vCol,lIni,lFim,cIni,cFim: integer;
  vValue: string;
begin
  vCol:= aGrid.Selection.Left;
  if ssCtrl in Shift then
    case key of
    vk_Down:
      begin
        lIni:=  aGrid.Selection.Top;
        if aGrid.Selection.Top <> aGrid.Selection.Bottom then
          lFim:= aGrid.Selection.Bottom
        else
          lFim:=  aGrid.RowCount -1;
        vValue:= aGrid.Cells[vCol,lIni];
        if ssAlt in Shift then
          PreencheDown(vCol,lIni,lFim,vValue,aGrid)
        else
          IncDown(vCol,lIni,lFim,vValue,aGrid);
      end;
    vk_Up:
      begin
        lIni:=  aGrid.Selection.Top;
        if aGrid.Selection.Top <> aGrid.Selection.Bottom then
          lFim:= aGrid.Selection.top
        else
          lFim:=  1;
        vValue:= aGrid.Cells[vCol,lIni];
        if ssAlt in Shift then
          PreencheUp(vCol,lIni,lFim,vValue,aGrid)
        else
          IncUp(vCol,lIni,lFim,vValue,aGrid);
      end;
    end//case
  else
    case key of
    vk_Delete:
      begin
        lIni:= aGrid.Selection.Top;
        lFim:= aGrid.Selection.Bottom;
        cIni:= aGrid.Selection.Left;
        cFim:= aGrid.Selection.Right;
        PreencheGrid(lIni,lFim,cIni,cFim,aGrid);
      end;
    vk_F5:
      begin
        lIni:= aGrid.Selection.Top;
        lFim:= aGrid.Selection.Bottom;
        cIni:= aGrid.Selection.Left;
        cFim:= aGrid.Selection.Right;
        PreencheGrid(lIni,lFim,cIni,cFim,aGrid,aValue);
      end;
    end;
end;

  {  Utilidades de Informação  }
Function GetMyVerInfo(ExeName:string):TVetStrIII;
(*  Obtém informações importantes sobre a versão do aplicativo passado
como parâmetro.
*)
const
  InfoNum = 10;
  InfoStr: array[1..InfoNum] of string =
    ('CompanyName', 'FileDescription', 'FileVersion', 'InternalName',
     'LegalCopyright', 'LegalTradeMarks', 'OriginalFileName', 'ProductName',
     'ProductVersion', 'Coments');
var
  S: string;
  n, Len, i: DWORD;
  Buf: PChar;
  Value: PChar;
begin
  Result:=ZeraVetStr2xX(maxVetStrIII);
  S := ExeName;
  n := GetFileVersionInfoSize(PChar(S), n);
  {
    Ingles 0409
    Porgutues 0416
  }
  if n > 0
  then begin
         Buf := AllocMem(n);
         Result[1][1]:='VersionInfoSize = ';
         Result[2][1]:= IntToStr(n);
         GetFileVersionInfo(PChar(S), 0, n, Buf);
         for i := 1 to InfoNum do
           if VerQueryValue(Buf, PChar('\\StringFileInfo\\041604E4\\' + InfoStr[i]), Pointer(Value), Len)
              then begin
                     Result[1][i+1]:=InfoStr[i] + ' = ';
                     Result[2][i+1]:= Value;
                   end;
         FreeMem(Buf, n);
       end
  else Result[1][1]:='Versão não encontrada';
end;

Function GetVerInfo(aTipoInfo: string; aVerArray: TVetStrIII): string;
const
  InfoNum = 10;
  InfoStr: array[1..InfoNum] of string =
    ('CompanyName', 'FileDescription', 'FileVersion', 'InternalName',
     'LegalCopyright', 'LegalTradeMarks', 'OriginalFileName', 'ProductName',
     'ProductVersion', 'Coments');
var
  vInfo: string;
  i: integer;
begin
  result:='None';
  for i:= 1 to maxVetStrIII do
    if Uppercase(aTipoInfo+ ' = ') = Uppercase(aVerArray[1][i]) then
    begin
      result:= aVerArray[2][i];
      break;
    end;
end;

  {  Utilidades de Teclado  }
function whatKey(key: word): string;
begin
  result:='-1';
  case key of
  48,96: result:='0';
  49,97: result:='1';
  50,98: result:='2';
  51,99: result:='3';
  52,100: result:='4';
  53,101: result:='5';
  54,102: result:='6';
  55,103: result:='7';
  56,104: result:='8';
  57,105: result:='9';
  37: result:= 'B';
  40: result:= 'L';
  39: result:= 'V';
  118: result:='ShowInfo';
  end;
end;

function ThereIsAKeyDown: boolean;
(* Passa por todas as teclas do teclado verificando se há alguma pressionada.
A velocidade definida no timer define a sensibilidade desta função.
*)
var
  i: integer;
begin
  result:= false;
  for i:= 0 to 255 do
    if (GetKeyState(i) and 128 > 0) then result:= true;
end;

function ThereIsAKeyDownInt: integer;
(* Passa por todas as teclas do teclado verificando se há alguma pressionada.
A velocidade definida no timer define a sensibilidade desta função.
*)
var
  i: integer;
begin
  result:=0;
  for i:= 0 to 255 do
    if (GetKeyState(i) and 128 > 0) then result:= result + i;
  if result = 0 then result:= -1;
end;

function ThereIsAKeyDownWord: Word;
(* Passa por todas as teclas do teclado verificando se há alguma pressionada.
A velocidade definida no timer define a sensibilidade desta função.
*)
var
  i: Word;
begin
  result:=0;
  for i:= 0 to 255 do
    if (GetKeyState(i) and 128 > 0) then result:= result + i;
//  if result = 0 then result:= -1;
end;

// Exemplo : PostKeyEx32(Ord('A'), [ssCtrl], false);
// Envia Ctrl+A para o controle que tiver o foco.
// Key : virtual keycode da tecla a enviar. Para caracteres
// imprimíveis informe o código ANSI (Ord(CHARACTER)).
// Shift : estado das teclas modificadoras.
// Shift, Control, Alt, Mouse Buttons.
// SpecialKey: normalmente deve ser False. Informe True se
// a tecla desejada for, por exemplo, do teclado numérico.
procedure PostKeyEx32(Key: Word; const Shift: TShiftState; SpecialKey: boolean);
type
  TShiftKeyInfo = Record
  shift: Byte;
  vkey : Byte;
End;
byteset = Set of 0..7;
const
ShiftKeys: array [1..3] of TShiftKeyInfo =
((shift: Ord(ssCtrl); vkey: VK_CONTROL ),
(shift: Ord(ssShift); vkey: VK_SHIFT ),
(shift: Ord(ssAlt); vkey: VK_MENU ));
var
Flag: DWORD;
bShift: ByteSet absolute shift;
i: Integer;
begin
  for i := 1 to 3 do begin
    if shiftkeys[i].shift in bShift then
    Keybd_Event(ShiftKeys[i].vkey,
    MapVirtualKey(ShiftKeys[i].vkey, 0), 0, 0);
  end; // for
  if SpecialKey Then
  Flag := KEYEVENTF_EXTENDEDKEY
  else
  Flag := 0;
  Keybd_Event(Key, MapvirtualKey(Key, 0), Flag, 0);
  Flag := Flag or KEYEVENTF_KEYUP;
  Keybd_Event(Key, MapvirtualKey(Key, 0), Flag, 0);
  for i := 3 DownTo 1 do
  begin
    if ShiftKeys[i].shift in bShift then
    Keybd_Event(shiftkeys[i].vkey,
    MapVirtualKey(ShiftKeys[i].vkey, 0),
    KEYEVENTF_KEYUP, 0);
  end; // for
end; // PostKeyEx32

  {  Criptografia  }
Function Embaralha(s:string):string;
var i:integer;
    b:byte;
    s1,s2:string;
begin
 s1:='';
 s2:='';
 for i:= 1 to Length(s) do
 begin
   b:=AchaNumStr(s[i]);
   s2:= AchaStrNum(b,2);
   s1:= s1 + S2;
 end;
 Embaralha:=s1;
end;

Function DesEmbaralha(s:string):string;
var i:integer;
    b:byte;
    s1,s2:string;
begin
 s1:='';
 s2:='';
 for i:= 1 to Length(s) do
 begin
   b:=AchaNumStr(s[i]);
   b:=b-2;
   s2:= AchaStrNum(b,0);
   s1:= s1 + S2;
 end;
 DesEmbaralha:=s1;
end;

function crypt(Action, Src: String; aAddKey: string = ''): String;
var
  KeyLen, KeyPos, OffSet, SrcPos, SrcAsc, TmpSrcAsc, Range: Integer;
  Dest, Key: String;
begin
  result := '';
  if Src <> '' then
  begin
    Key := 'MinhaChaveDoJLes'+aAddKey;
    Dest := '';
    KeyLen := Length(Key);
    KeyPos := 0;
    SrcPos := 0;
    SrcAsc := 0;
    Range := 256;
    if (UpperCase(Action) = 'C') then
    begin
      Randomize;
      OffSet := Random(Range);
      Dest := Format('%1.2x',[OffSet]);
      for SrcPos := 1 to Length(Src) do
      begin
        Application.ProcessMessages;
        SrcAsc := (Ord(Src[SrcPos]) + OffSet) Mod 255;
        if KeyPos < KeyLen then KeyPos := KeyPos + 1 else KeyPos := 1;
        SrcAsc := SrcAsc Xor Ord(Key[KeyPos]);
        Dest := Dest + Format('%1.2x',[SrcAsc]);
        OffSet := SrcAsc;
      end;
    end
    else if (UpperCase(Action) = 'D') then
    begin
      OffSet := StrToInt('$'+ copy(Src,1,2));
      SrcPos := 3;
      repeat
        SrcAsc := StrToInt('$'+ copy(Src,SrcPos,2));
        if (KeyPos < KeyLen) then
          KeyPos := KeyPos + 1 else
          KeyPos := 1;
        TmpSrcAsc := SrcAsc Xor Ord(Key[KeyPos]);
        if TmpSrcAsc <= OffSet then
          TmpSrcAsc := 255 + TmpSrcAsc - OffSet else
          TmpSrcAsc := TmpSrcAsc - OffSet;
        Dest := Dest + Chr(TmpSrcAsc);
        OffSet := SrcAsc;
        SrcPos := SrcPos + 2;
      until (SrcPos >= Length(Src));
    end;
    Result:= Dest;
  end;
end;


  {  Tratamento de data  }
function validaDateTime(aValor: string):TTestaDateTime;
var
  data: TDateTime;
begin
  result:=iNone;
  try
   data:= StrToDate(aValor);
   result:= iDate;
  except
    try
     data:= StrToTime(aValor);
     result:= iTime;
    except
      result:= iNone;
    end;
  end;
end;

function formatDateBR(aValor: string):string;
var
  d: TDateTime;
  aa,mm,dd: word;
begin
  try
    d:= StrToDate(aValor);
    decodeDate(d,aa,mm,dd);
    result:= intToStr(mm)+'/'+intToStr(dd)+'/'+intToStr(aa);
  except
    result:= 'null';
  end;
end;

{ O procedimento abaixo foi criado como uma medida desesperada para consertar o tratamento de data
do delphi que não reconhece datas como 10/17/2014 como sento data válida para conversão
Tenho que estudar mais os formatos de data heheheheheheh
}
function formatDateStrToBR(aValor: string):string;
var
  d: TDateTime;
  aa,mm,dd: word;
  mmm,ddd,aaa, nd: string;
begin
  try
    mmm:= GetItemFromStrComaSep(aValor,1,'/');
    ddd:= GetItemFromStrComaSep(aValor,2,'/');
    aaa:= GetItemFromStrComaSep(aValor,3,'/');
    nd:= ddd + '/' +mmm + '/' +aaa + '/';
//    d:= StrToDate(nd);
    result:= nd;

//    decodeDate(d,aa,mm,dd);
//    result:= intToStr(dd)+'/'+intToStr(mm)+'/'+intToStr(aa);
  except
    result:= 'null';
  end;
end;

function myIncDate(aDtIni: TDate; aNumInc: integer; aIntervalo: integer;
         aDD: word; aFixaDia: Boolean = true): TDate;
var
  i: integer;
  vDtParc: TDate;
  vdd,vmm,vaa: word;
  vDtAux: TDate;
begin
  {Gerar Parcelas
    levar em conta intervalo entre parcelas e número de parcelas
  }
  vDtParc:= aDtIni;
  if aFixaDia then
    vDtParc:= IncMonth(vDtParc,aNumInc)
  else
  for i:= 1 to aNumInc do
    begin
      vDtParc:= incDay(vDTParc,aIntervalo);
      if i = aNumInc then
        break;
    end;
  if aFixaDia then
  begin
    vDtAux:= vDtParc;
    DecodeDate(vDtAux,vaa,vmm,vdd);
    vDtParc:= EncodeDate(vaa,vmm,aDD);
  end;
  Result:= vDtParc;
end;


function GetValueIP(aIP: string; aPos: integer): word;
var
  i: integer;
  cont, max: integer;
  aux: string;
begin
  result:=0;
  cont:= 0;
  max:= length(aIP);
  aux:='';
  for i:= 1 to max do
    if aIP[i]<> '.' then
        aux:= aux + aIP[i]
    else
      begin
        inc(cont);
        if cont = aPos then
          begin
            result:= strToInt(aux);
            break;
          end
        else
            aux:='';
      end;
  result:= strToInt(aux);
end;


{_____________________________________________________________________________}
function ValidaCPF(num:string): boolean;
var n1, n2, n3, n4, n5, n6, n7, n8, n9: integer;
    d1, d2: integer;
    digitado, calculado: string;
begin
  n1 := StrToInt(num[1]);
  n2 := StrToInt(num[2]);
  n3 := StrToInt(num[3]);
  n4 := StrToInt(num[4]);
  n5 := StrToInt(num[5]);
  n6 := StrToInt(num[6]);
  n7 := StrToInt(num[7]);
  n8 := StrToInt(num[8]);
  n9 := StrToInt(num[9]);
  d1 := n9*2 + n8*3 + n7*4 + n6*5 + n5*6 + n4*7 + n3*8 + n2*9 + n1*10;
  d1 := 11 - (d1 mod 11);
  if (d1>=10) then d1:=0;
  d2 := d1*2 + n9*3 + n8*4 + n7*5 + n6*6 + n5*7 + n4*8 + n3*9 + n2*10 + n1*11;
  d2 := 11 - (d2 mod 11);
  if (d2>=10) then d2:=0;
  calculado := IntToStr(d1) + IntToStr(d2);
  digitado  := num[10] + num[11];
  if calculado=digitado then
     ValidaCPF := True
  else
     ValidaCPF := False;
end;

function ValidaCGC(num:string): boolean;
var n1, n2, n3, n4, n5, n6, n7, n8, n9, n10, n11, n12: integer;
    d1, d2: integer;
    digitado, calculado: string;
begin
  n1  := StrToInt(num[1]);
  n2  := StrToInt(num[2]);
  n3  := StrToInt(num[3]);
  n4  := StrToInt(num[4]);
  n5  := StrToInt(num[5]);
  n6  := StrToInt(num[6]);
  n7  := StrToInt(num[7]);
  n8  := StrToInt(num[8]);
  n9  := StrToInt(num[9]);
  n10 := StrToInt(num[10]);
  n11 := StrToInt(num[11]);
  n12 := StrToInt(num[12]);
  d1 := n12*2 + n11*3 + n10*4 + n9*5 + n8*6 + n7*7 + n6*8 + n5*9 + n4*2 + n3*3 + n2*4 + n1*5;
  d1 := 11 - (d1 mod 11);
  if (d1>=10) then d1:=0;
  d2 := d1*2 + n12*3 + n11*4 + n10*5 + n9*6 + n8*7 + n7*8 + n6*9 + n5*2 + n4*3 + n3*4 + n2*5 + n1*6;
  d2 := 11 - (d2 mod 11);
  if (d2>=10) then d2:=0;
  calculado := IntToStr(d1) + IntToStr(d2);
  digitado  := num[13] + num[14];
  if calculado=digitado then
     ValidaCGC := True
  else
     ValidaCGC := False;
end;

function ValidaNIRE(num:string): boolean;
var n1, n2, n3, n4, n5, n6, n7, n8, n9, n10: integer;
    d1, d2: integer;
    digitado, calculado: string;
begin
  n1  := StrToInt(num[1]);
  n2  := StrToInt(num[2]);
  n3  := StrToInt(num[3]);
  n4  := StrToInt(num[4]);
  n5  := StrToInt(num[5]);
  n6  := StrToInt(num[6]);
  n7  := StrToInt(num[7]);
  n8  := StrToInt(num[8]);
  n9  := StrToInt(num[9]);
  n10 := StrToInt(num[10]);
  d1 := n1*2 + n2*10 + n3*9 + n4*8 + n5*7 + n6*6 + n7*5 + n8*4 + n9*3 + n10*2;
  d1 := 11 - (d1 mod 11);
  if (d1>9) then
     d1 := d1-10;

  calculado := IntToStr(d1);
  digitado  := num[11];
  if calculado=digitado then
     ValidaNIRE := True
  else
     ValidaNIRE := False;
end;

Function PrepForSql(V:TVetStr; Invert: TInvData):TVetStr;
var j:integer;
    aux,atual:string;
    d:TDateTime;
    i:integer;
    R:real;
    eInt,eStr,eDate,eFloat:boolean;

begin
  for j:= 1 to maxVetStr do
  begin
    eInt:=false;
    eStr:=false;
    eDate:=false;
    eFloat:=false;
    atual:=v[j];

    if atual ='IGNORE'
       then break;
    if uppercase(atual) = 'NULL'
       then v[j]:=atual
       else begin
              try
                i:=StrToInt(atual);
                eInt:=True;
              except
                 eInt:=False;
                 try
                   R:=StrToFloat(atual);
                   eFloat:=True;
                 except
                   eFloat:=False;
                   try
                     d:=StrToDate(atual);
                     eDate:=true;
                   except
                     eDate:=False;
                     eStr:=True;
                   end;
                 end;
              end;
              if (eStr = true) or (eDate = true)
                 then begin
                       if eStr
                          then begin
                                 if uppercase(atual) <> 'NULL'
                                    then v[j]:=chr(39)+atual+chr(39)
                                    else v[i]:=atual;
                               end
                          else begin
                                 //preparar data para formato IB

                               if uppercase(atual) <> 'NULL'
                                  then begin
                                        if Invert = iInverte
                                           then atual:=myDateToStr(d);
                                        v[j]:=chr(39)+atual+chr(39);
                                       end
                                  else v[j]:=atual;

                               end;
                      end
                 else begin
                        if eFloat
                           then begin
                                  //
                                  atual:=RetornaPonto(atual);
                                  v[j]:=atual;
                                end
                           else v[j]:=atual;
                      end;
            end;
  end;//for
  PrepForSql:=v;
end;

function removeEspacofinal(V:TVetStr):TVetStr;
var i,j,esp:integer;
    atual,aux:string;
begin
  for i:= 1 to MaxVetStr do
  begin
     atual:=v[i];
     if atual = 'IGNORE'
        then break;
     esp:=0;
     if length(atual) > 1
        then begin
               for j:= length(atual) downto 1 do
               begin
                   {
                      Removendo espaços do final
                   }
                   if atual[j] = ' '
                      then begin end
                      else begin
                            esp:=j;
                            break;
                           end;
               end;//for
               aux:=copy(atual,1,esp);
             end
        else aux:= atual;
     v[i]:=aux;
  end;
  RemoveEspacoFinal:=v;
end;

procedure criarGenerator(L:TListBox; memoSubst,memoDest:TMemo);
var k,i,pos:integer;
    linha,nome:string;
begin
  memoDest.clear;
  for k:= 0 to l.Count -1 do
  begin
    nome:='';
    if L.Selected[k]
       then begin
              nome:=LimpaStr(L.Items.Strings[k]);
              pos:=AnsiPos('TB',nome);
              if pos <> 0
                 then delete(nome,pos,2);
            end
       else continue;
    for i:= 0 to memoSubst.Lines.Count -1 do
    begin
      linha:=memoSubst.Lines.Strings[i];
      pos:=ansiPos('[]',linha);
      if  pos <> 0
         then begin
                delete(linha,pos,2);
                insert(nome,linha,pos);
              end;
       memoDest.Lines.Add(linha);
    end;//for
  end;//for
end;

Procedure CarregaSelecao(List:TListBox; Memo:TMemo; NomeArq:string);
var t,i:integer;
    s:string;
begin
  if FileExists(NomeArq)
     then begin
            Memo.Lines.LoadFromFile(NomeArq);
            for i:=0 to Memo.Lines.Count -1 do
            begin
              s:=Memo.Lines.Strings[i];
              if s <> '-1'
                 then List.Selected[i]:= not(List.Selected[i]);
            end;//for
          end;
end;

Procedure SalvaSelecao(List:TListBox; Memo:TMemo; NomeArq:string);
var i:integer;
begin
  {
      Salvar padrão para exames
  }
  Memo.Lines.Clear;
  for i:= 0 to List.Count -1 do
   if List.Selected[i]
      then Memo.Lines.Add(IntToStr(i))
      else Memo.Lines.Add('-1');
  Memo.Lines.SaveToFile(NomeArq);
end;

function ZeraVetStrIII:TvetStrIII;
var i,j:integer;
begin
  for i:= 1 to 2 do
    for j:=1 to maxVetStrIII do ZeraVetStrIII[i,j]:='IGNORE';
end;

Function RetornaInfo(oQue:String; vVer:TVetStrIII):String;
var i:integer;
begin
  for i:= 1 to MaxVetStrIII do
  if oQue = vVer[1][i]
     then begin
            RetornaInfo:= vVer[2][i];
            break;
          end
     else begin
            RetornaInfo:=vVer[1][1];
          end
end;

Function myVerInfo(ExeName:string):TVetStrIII;
const
  InfoNum = 10;
  InfoStr: array[1..InfoNum] of string = ('CompanyName', 'FileDescription', 'FileVersion', 'InternalName', 'LegalCopyright', 'LegalTradeMarks', 'OriginalFileName', 'ProductName', 'ProductVersion', 'Coments');
var
  S: string;
  n, Len, i: DWORD;
  Buf: PChar;
  Value: PChar;
begin
  myVerInfo:=ZeraVetStrIII;
  S := ExeName;
  n := GetFileVersionInfoSize(PChar(S), n);
  if n > 0
  then begin
         Buf := AllocMem(n);
         myVerInfo[1][1]:='VersionInfoSize = ';
         myVerInfo[2][1]:= IntToStr(n);
         GetFileVersionInfo(PChar(S), 0, n, Buf);
         for i := 1 to InfoNum do
           if VerQueryValue(Buf, PChar('\\StringFileInfo\\041604E4\\' + InfoStr[i]), Pointer(Value), Len)
              then begin
                     myVerInfo[1][i+1]:=InfoStr[i] + ' = ';
                     myVerInfo[2][i+1]:= Value;
                   end;
         FreeMem(Buf, n);
       end
  else myVerInfo[1][1]:='Versão não encontrada';
end;

Function Falar(nomeArq:string; Criar,esperar:boolean):TMediaPlayer;
begin
  if criar
     then MediaPlay:=TMediaPlayer.Create(nil)
     else MediaPlay.Free;
  with MediaPlay do
  begin
    ParentWindow:=Application.Handle;
    AutoRewind:=True;
    FileName:= NomeArq;
    open;

    try
     if esperar
        then Wait:=True;
    play;
    finally
      close;
    end;
  end;
end;

Function corrigeHora(hora:String):string;
var teste,i:integer;
    nHora,caux:string;
    h:TDateTime;
begin
  try
    h:=StrToTime(hora);
  except
    exit;
  end;
  caux:='';
  nHora:='';
  for i:= 1 to length(hora) do
  begin
    caux:= hora[i];
    if caux <> ':'
       then try
               teste:=StrToInt(caux);
            except
               caux:='0';
            end;
       nHora:=nHora+caux;
  end;//for
  corrigeHora:=nHora;
end;

Procedure CheckTDiag(D1,D2:TDateTimePicker; LblDiag,LblDiagII:TLabel; DtNasc,DtColeta,HoraNasc,HoraColeta:string; check:TCheckBox);
var dif:Real;
begin
  //Calculando o tipo de diagnóstico
  D1.Date:=StrToDate(DtNasc);;
  D2.Date:=StrToDate(DtCOLETA);
  D1.Time:=StrToTime(HoraNasc);
  D2.Time:=StrToTime(HoraColeta);
  dif:= (D1.DateTime - D2.DateTime) * -1;
  if dif < 2
     then begin
            lblDiag.Caption:='Amostragem Precoce';
            lblDiagII.Caption:='Menos de 24 Horas.';
            LblDiag.Font.Color:=clRed;
            if check.Checked
               then falar(PathAcles+'\sons\datas.wav',cria,esperar);
          end
     else if dif > 30
             then begin
                     lblDiag.Caption:='Diagnóstico Tardio';
                     lblDiagII.Caption:='Mais de 30 dias.';
                     LblDiag.Font.Color:= clInfoBk;
                     if check.Checked
                        then falar(PathAcles+'\sons\datas.wav',cria,esperar);
                  end
             else begin
                    lblDiag.Caption:='Amostragem Normal.';
                    LblDiagII.Caption:='';
                    LblDiag.Font.Color:=clGreen;
                  end;
end;

procedure AddButtons(ToolBar: TToolBar;
  Const ButtonCaptions: array of String);
var
  I: Integer;
begin
  for I := 0 to High(ButtonCaptions) do
    begin
      with TToolButton.Create(ToolBar) do
      begin
        Parent := ToolBar;
        Caption := ButtonCaptions[I];
        if (ButtonCaptions[I] = '|') then
          Style := tbsSeparator
        else
          Style := tbsButton;
      end;
    end;
end;


Function ZeraVetLimiteBase:TVetLimiteBase;
var i:integer;
begin
  for i:= 1 to MaxVetLimiteBase do ZeraVetLimiteBase[i]:='IGNORE';
end;

Function ZeraVetLimiteMatrix:TVetLimiteMatrix;
var i,j:integer;
begin
  for i:= 1 to MaxVetLimiteBase do
    for j:=1 to MaxVetLimiteMatrix do ZeraVetLimiteMatrix[i,j]:='IGNORE';
end;

function ZeraVetStr:TvetStr;
var i:integer;
begin
  for i:= 1 to maxVetStr do ZeraVetStr[i]:='IGNORE';
end;

function ZeraVetStrII:TvetStrII;
var i,j:integer;
begin
  for i:= 1 to maxVetStr do
    for j:=1 to maxVetStrII do ZeraVetStrII[i,j]:='IGNORE';
end;

Procedure SalvarLog(var memo:TMemo; User,Perfil,App,Caminho:String );
var Nome:String;
    data:TDateTime;
    dataStr:string;
    yy,dd,mm,hor,min,seg,mseg:word;
begin
  Data:= now();
  decodeDate(data,yy,mm,dd);
  decodeTime(data,hor,min,seg,mseg);
  DataStr:= IntToStr(yy)+'_'+IntToStr(mm)+'_'+IntToStr(dd)+' '+IntToStr(hor)+'_'+IntToStr(min)+'_'+IntToStr(seg)+' ';
  nome:=APP+' '+DataStr+User+' '+Perfil;
  Memo.Lines.SaveToFile(caminho+nome+'.log');
end;

Function GetWordII(P,separador:String):TVetStr;
var linha:string;
    pos,i:integer;
begin
  //
  getWordII:=ZeraVetStr;
  linha:=uppercase(p);
  i:=1;
  repeat
    pos:=ansiPos(separador,linha);
    if pos <> 0
       then begin
              GetWordII[i]:=copy(linha,1,pos-1);
              delete(linha,1,pos);
              inc(i);
            end
       else if linha <> '' then GetWordII[i]:=linha;
  until pos = 0;
  if (linha <> '') and (i = 1)
     then getWordII[1]:=linha;
end;

Function GetWord(P:String):TVetStr;
var caux:string;
    i,cont:integer;
    vp:TVetStr;
    ch:char;
    Incred:boolean;
begin
    getWord:=zeraVetStr;
    vp:=ZeraVetStr;
    if p = '' //Verificar se este é o valor que vem qdo vazio
       then begin
              getWord:=vp;
              exit;
            end;
    caux:='';
    cont:=1;
    ch:=#39;
    Incred:=false;
    for i:= 1 to length(p) do
    begin
      Application.ProcessMessages;
      ch:=p[i];
      if (ch = ' ') or (ch = #9) or (ch =#13)
         then begin
               if (caux <> ' ') and (caux <> '') //tem uma palavra inteira
                  then begin
                         vp[cont]:= caux;
                         inc(cont);
                         caux:='';
                         Incred:=True;
                       end;
              end
         else
         if (ch <> ';') and (ch <> ',') and (i <> length(p)) //and (ch <> '(') //and (ch <> ')')
            then caux:= caux + p[i];
    end;//for
    {
     Garantindo que uma palavra sozinha vai ser retornada
    }
    if not(Incred)
       then VP[1]:=caux;
    {
     Garantindo que a última palavra vai ser retornada
    }
    if (ch = ';') or (ch = ',') or (ch = ')')
       then vp[cont]:= caux;
   getWord:=vp;
end;

Procedure ShowTabs(Tab:TPageControl; aCaptions:TArrayStr; sim:boolean); Overload;
var j,i:integer;
begin
 // setLength(names,Quantidade);
 for i:= 0 to Tab.PageCount -1 do
 begin
    for j:= 0 to high(aCaptions) do
      if UpperCase(Tab.Pages[i].Caption) = UpperCase(aCaptions[j])
         then Tab.Pages[i].TabVisible:=sim;
 end;
end;

{Function achaNumStr(b:string):Byte;
var i:Byte;
    c:char;
begin
  for i:= 0 to 255 do
  begin
      c:=chr(i);
      if b[1] = c
        then begin
              achaNumStr:=i;
              exit
             end;
  end;
  achaNumStr:=39;
end;

Function achaStrNum(b,f:byte):string;
begin
  achaStrNum:=chr(b+f);
end;
}

{Function LimpaStr(VStr:string):string;
var i,tam:integer;
    c:string;
    caux:char;
begin
 tam:=Length(VStr);
 c:='';
 for i:= 1 to tam do
 begin
    caux:= VStr[i];
    if (caux in ['a'..'z']) or (caux in ['A'..'Z'])
       then c:= c+ caux;
 end;
 LimpaStr:=c;
end;
}

function GetTimeFrom(data:TDateTime): TTime;
var hora, Min, Sec, mSec: word;
begin
 decodeTime(data,Hora,Min,Sec,msec);
 result:= encodeTime(Hora,Min,Sec,mSec);
end;

function GetDateFrom(data:TDateTime): TDate;
var ano, mes, dia: word;
begin
 decodeDate(data,ano,mes,dia);
 result:= encodeDate(ano,mes,dia);
end;

function MyDateToStr(data:TDateTime):string;
var ano,mes,dia:word;
begin
  decodedate(data,ano,mes,dia);
  myDateToStr:=intToStr(mes)+'/'+intToStr(dia)+'/'+intToStr(ano);
end;

function TimeCompletion(pTime: string): string;
const
  sep = ':';
var
  index, tam: integer;
  vTime: TTime;
  vHora,vMin,vSeg: string;
begin
  pTime:=trim(pTime);
  tam:= length(pTime);
  if tam = 1 then begin result:= '0'+pTime+':00:00'; exit; end;
  if tam = 2 then begin result:= pTime+':00:00'; exit; end;

  Index:= ansiPos(Sep,pTime);
  if Index <> 0 then begin
    vHora:= copy(pTime,1,Index-1);
    delete(pTime,1,Index);
  end;

  index:= ansiPos(sep,pTime);
  if index <> 0 then begin
    vMin:= copy(pTime,1,index-1);
    vSeg:= copy(pTime,index+1,length(pTime));
  end else begin
    vMin:= pTime;
    vSeg:='00';
  end;
  pTime:= vHora+':'+vMin+':'+vSeg;
  try
    vTime:=StrToTime(pTime);
    result:= TimeToStr(vTime);
  except
    result:= pTime;
  end;
end;

function getNumber(aStr: string):integer;
  const
    sepIni='(';
    sepFim=')';
  var
    indexIni,IndexFim: integer;
    aux: string;
  begin
    try
      indexIni:= ansiPos(sepIni,aStr);
      IndexFim:= ansiPos(sepFim,Astr);
      aux:= copy(astr,IndexIni+1,(IndexFim-1)-IndexIni);
      result:= StrToInt(aux);
    except
      result:= -1;
    end;
  end;

function myStrCharPos(aSubStr: string; aStr: string): integer;
var
  i: integer;
begin
  result:=-1;
  for i:= 1 to length(aStr) do begin
    if aStr[i] = aSubStr then begin result:= i; break; end
  end;
end;

function RemoverSlash(aPath: string; aSlash: string = '\'): string;
var
  vLen: integer;
begin
  result:= aPath;
  if aPath = '' then exit;
  vLen:= length(aPath);
  if aPath[vLen] = aSlash then
    result:= copy(aPath,1,Length(aPath)-1);
end;

function IncluirSlash(aPath: string; aSlash: string = '\'; aInclude: boolean = true): string;
var
  vLen: integer;
begin
  result:= aPath;
  if aPath = '' then exit;
  vLen:= length(aPath);
  if aInclude then begin
    if aPath[vLen]<>aSlash then
      result:= aPath+aSlash;
  end else begin
    if aPath[vLen]=aSlash then
      result:= copy(aPath,1,vLen-1);
  end;
end;

function ChangeSlash(aPath: string; aSlash: string = '\'; aToSlash: string = '/'): string;
var
  vLen: integer;
  i: integer;
begin
  result:= aPath;
  vLen:= length(aPath);
  for i:= 1 to vLen do begin
    if aPath[i]=aSlash then
      aPath[i]:= aToSlash[1];
  end;
  result:= aPath;
end;

procedure DoUpdateSetas(aStrings: TStrings; aDirecao: TDirecao = dDown);
var
  i: integer;
begin
  case aDirecao of
  dUp:
    begin
      for i:= aStrings.Count-1 Downto 0 do begin
        if STRUtils.AnsiStartsStr('->',aStrings.Strings[i]) then begin
          if i >=1 then begin
            aStrings.Strings[i]:= copy(aStrings.Strings[i],3,length(aStrings.Strings[i]));
            aStrings.Strings[i+1]:= '->'+aStrings.Strings[i+1];
            break;
          end;
        end;
      end;
    end;
  dDown:
    begin
      for i:= 0 to aStrings.Count-1 do begin
        if STRUtils.AnsiStartsStr('->',aStrings.Strings[i]) then begin
          if i <=aStrings.Count then begin
            aStrings.Strings[i]:= copy(aStrings.Strings[i],3,length(aStrings.Strings[i]));
            aStrings.Strings[i+1]:= '->'+aStrings.Strings[i+1];
            break;
          end;
        end;
      end;
    end;
  end;
end;
(*function retornaPonto(ffloat:string):string;
var i: integer;
    newvar:string;
    caracter:char;
    jafoi{,inteiro}:boolean;
begin
  //
  if ffloat = '' then newVar:='0.0'
  else
  begin
    jafoi:=false;
    newvar:='';
    for i:= 1 to length(ffloat) do
    begin
       {inteiro:=true;}
       if (ffloat[i]=',') or (ffloat[i]='.')
          then begin
                 if not(jafoi) then newvar:=newvar + '.';
                 jafoi:=true;
               end
          else begin
                 caracter:=ffloat[i];
                 if Caracter in ['0'..'9'] then newvar:=newvar + Caracter;
                 {try
                   caracter:=ffloat[i];
                   teste:=StrToInt(Caracter);
                 except
                   inteiro:=false;
                 end;
                 if inteiro then newvar:=newvar + Caracter;}
               end;
      end;
  end;
  retornaPonto:=newvar;
end;

function retornaVirgula(ffloat:string):string;
var i: integer;
    newvar,caracter:string;
    jafoi,inteiro:boolean;
    teste:integer;
begin
  //
  if ffloat = '' then newvar:='Null'
  else
  begin
    jafoi:=false;
    newvar:='';
    for i:= 1 to length(ffloat) do
    begin
       inteiro:=true;
       if ffloat[i]='.'
          then begin
                 if not(jafoi) then newvar:=newvar + ',';
                 jafoi:=true;
               end
          else begin
               try
                  caracter:=ffloat[i];
                  teste:=StrToInt(Caracter);
               except
                 inteiro:=false;
               end;
               if inteiro then newvar:=newvar + ffloat[i];
             end;
      end;
    end;
    retornaVirgula:=newvar;
end;
*)

{

}

procedure Mostrar(PgCtrl: TPageControl;Capt:string; sim:boolean);
var Tabs:TArrayStr;
begin
  setLength(tabs,1);
  tabs[0]:=Capt;
  showTabs(PgCtrl,tabs,sim);
end;

Procedure MessageBar(STBar:TStatusBar; Mess:string);
begin
  StBar.SimpleText:=Mess;
end;

{Function Embaralha(s:string):string;
var i:integer;
    b:byte;
    s1,s2:string;
begin
 s1:='';
 s2:='';
 for i:= 1 to Length(s) do
 begin
   b:=AchaNumStr(s[i]);
   s2:= AchaStrNum(b,2);
   s1:= s1 + S2;
 end;
 Embaralha:=s1;
end;

Function DesEmbaralha(s:string):string;
var i:integer;
    b:byte;
    s1,s2:string;
begin
 s1:='';
 s2:='';
 for i:= 1 to Length(s) do
 begin
   b:=AchaNumStr(s[i]);
   b:=b-2;
   s2:= AchaStrNum(b,0);
   s1:= s1 + S2;
 end;
 DesEmbaralha:=s1;
end;
}

Function GetFName(OD:TOpenDialog):String;
begin
  if OD.Execute
     then Result:= OD.FileName;
end;

Procedure UpTabs(Tab:TPageControl; caption: string); overload;
var j,i:integer;
begin
 // setLength(names,Quantidade);
try
 for i:= 0 to Tab.PageCount -1 do
 begin
    for j:= 0 to tab.PageCount -1 do
      if UpperCase(Tab.Pages[i].Caption) = UpperCase(caption)
         then Tab.ActivePageIndex:= i;
 end;
except end; 
end;

Procedure UpTabs(Tab:TPageControl; names:TArrayStr); overload;
var j,i:integer;
begin
 // setLength(names,Quantidade);
 for i:= 0 to Tab.PageCount -1 do
 begin
    for j:= 0 to high(names) do
      if UpperCase(Tab.Pages[i].Caption) = UpperCase(names[j])
         then Tab.ActivePageIndex:= i;
 end;
end;

Procedure hideTabs(Tab:TPageControl; names:TArrayStr; OPC:boolean); Overload;
var j,i:integer;
begin
 // setLength(names,Quantidade);
 for i:= 0 to Tab.PageCount -1 do
 begin
    for j:= 0 to high(names) do
      if UpperCase(Tab.Pages[i].Caption) = UpperCase(names[j])
         then try
                if opc
                   then Tab.Pages[i].TabVisible:=false
                   else Tab.Pages[i].TabVisible:=true;
                continue;
              except
              end;
 end;
end;

Procedure hideTabs(Tab:TPageControl; Index,Quantas:integer);
var i:integer;
begin
    for i:= index to Quantas do
    try
      Tab.Pages[i].TabVisible:=false;
    except
    end;
end;

function GetUnicUsrName(aUsrName: string): string;
var
  i: Integer;
  vUnic: string;
begin
  vUnic:='';
  for i := 1 to Length(aUsrName) do
  begin
    vUnic:= vUnic + aUsrName[i];
    if aUsrName[i] = ' ' then Break;
  end;
  result:= vUnic;
end;


Function MemoToLinha(memo:TMemo; Separador:string):String;
var i:integer;
    linha:String;
begin
   linha:='';
   for i:= 0 to memo.lines.count -1 do
     linha:= linha + memo.Lines.Strings[i]+Separador;
   MemoToLinha:=linha;
end;

Procedure LinhaToMemo(Linha:String;var memo:TMemo);
var i:integer;
    caux:string;
    clinha:integer;
begin
  caux:='';
  memo.Clear;
  cLinha:=0;
  for i:=1 to length(linha) do
  begin
    if (linha[i] <> '#') and (i <> length(linha))
       then caux:=caux + linha[i]
       else begin
              if caux <> ' '
                 then begin
                        memo.Lines.Insert(cLinha,caux);
                        inc(clinha);
                      end;
              caux:=''
            end;
  end;
  memo.Lines.Delete(memo.Lines.Count);
end;


{Rotinas do Extenso}

{
Como esta rotina visa a ser compatÃ tambÃ©m com Delphi 1 e Turbo Pascal,
optei por manipular strings usando apenas o bÃ¡sico do bÃ¡sico (sem recorrer Ã
SysUtils) e por usar tipos nÃºmericos simples. Lembre-se que o tipo extended
pode apresentar ligeiras imprecisÃµes em nÃºmeros na casa das centenas de
trilhÃ£o.
A funÃ§Ã£o ReplaceSubstring poderia ser facilmente substituÃ com recursos do
Delphi, mas, como jÃ¡ disse, optei por usar uma implementaÃ§Ã£o mais pascalista
mesmo, e portanto menos sujeita a problemas de versÃ£o do Pascal (Turbo Pascal,
Think Pascal, Borland Pascal, Delphi 1-7, Kylix, etc).
}
function ReplaceSubstring( StringAntiga, StringNova, s : string ) : string;
var p : word;
begin
  repeat
    p := Pos( StringAntiga, s );
    if p > 0 then begin
      Delete( s, p, Length( StringAntiga ) );
      Insert( StringNova, s, p );
    end;
  until p = 0;
  ReplaceSubstring := s;
end;


{ Esta Ã© a funÃ§Ã£o que gera os blocos de extenso que depois serÃ£o montados }
function Extenso3em3( Numero : Word ) : string;
const Valores : array[1..36] of word = ( 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12,
13, 14, 15, 16, 17, 18, 19, 20, 30, 40, 50, 60, 70, 80, 90,
100, 200, 300, 400, 500, 600, 700, 800, 900 );
Nomes : array[0..36] of string[12] = ( '', 'UM', 'DOIS', 'TRES', 'QUATRO',
'CINCO', 'SEIS', 'SETE', 'OITO', 'NOVE', 'DEZ', 'ONZE',
'DOZE', 'TREZE', 'QUATORZE', 'QUINZE', 'DEZESSEIS',
'DEZESSETE', 'DEZOITO', 'DEZENOVE', 'VINTE', 'TRINTA',
'QUARENTA', 'CINQUENTA', 'SESSENTA', 'SETENTA', 'OITENTA',
'NOVENTA', 'CENTO', 'DUZENTOS', 'TREZENTOS', 'QUATROCENTOS',
'QUINHENTOS', 'SEISCENTOS', 'SETECENTOS', 'OITOCENTOS',
'NOVECENTOS' );
var i         : byte;
Resposta  : string;
Inteiro   : word;
Resto     : word;
begin
  Inteiro   := Numero;
  Resposta  := '';

  for i := 36 downto 1 do begin
    Resto := ( Inteiro div valores[i] ) * valores[i];
    if ( Resto = valores[i] ) and ( Inteiro >= Resto ) then begin
      Resposta := Resposta + Nomes[i] + ' E ';
      Inteiro  := Inteiro - Valores[i];
    end;
  end;

  { Corta o 'E' excedente do final da string }
  Extenso3em3 := Copy( Resposta, 1, Length( Resposta ) - 3 );
end;


{
A funÃ§Ã£o extenso divide os nÃºmeros em grupos de trÃªs e chama a funÃ§Ã£o
extenso3em3 para o obter extenso de cada parte e armazenÃ¡-los no vetor
Resposta.
}
function Extenso( Numero: Integer; vMoeda: boolean = false) : string;
const NoSingular : array[1..6] of string = ( 'TRILHÃO', 'BILHÃO', 'MILHÃO', 'MIL',
'REAL', 'CENTAVO' );
NoPlural   : array[1..6] of string = ( 'TRILHÕES', 'BILHÕES', 'MILHÕES', 'MIL',
'REAIS', 'CENTAVOS' );
{
Estas constantes facilitam o entendimento do cÃ³digo.
Como os valores de singular e plural sÃ£o armazenados em um vetor,
cada posicao indica a grandeza do nÃºmero armazenado (leia-se sempre
da esquerda para a direita).
}
CasaDosTrilhoes = 1;
CasaDosBilhoes  = CasaDosTrilhoes + 1;
CasaDosMilhoes  = CasaDosBilhoes  + 1;
CasaDosMilhares = CasaDosMilhoes  + 1;
CasaDasCentenas = CasaDosMilhares + 1;
CasaDosCentavos = CasaDasCentenas + 1;

var
  vPos,i: integer;
  vTeste: string;
TrioAtual,
TrioPosterior : byte;
v             : integer; { usada apenas com o Val }
Resposta      : array[CasaDosTrilhoes..CasaDosCentavos] of string;
RespostaN     : array[CasaDosTrilhoes..CasaDosCentavos] of word;
Plural        : array[CasaDosTrilhoes..CasaDosCentavos] of boolean;
Inteiro       : extended;
NumStr        : string;
TriosUsados   : set of CasaDosTrilhoes..CasaDosCentavos;
NumTriosInt   : byte;

{ Para os nÃ£o pascalistas de tradiÃ§Ã£o, observe o uso de uma funÃ§Ã£o
encapsulada na outra. }
function ProximoTrio( i : byte ) : byte;
begin
  repeat
    Inc( i );
  until ( i in TriosUsados ) or ( i >= CasaDosCentavos );
  ProximoTrio := i;
end;

begin
  Inteiro  := Int( Numero * 100 );

  { Inicializa os vetores }
  for TrioAtual := CasaDosTrilhoes to CasaDosCentavos do begin
    Resposta[TrioAtual] := '';
    Plural[TrioAtual]   := False;
  end;

  {
  O nÃºmero Ã© quebrado em partes distintas, agrupadas de trÃªs em trÃªs casas:
  centenas, milhares, milhÃµes, bilhÃµes e trilhÃµes. A Ãºltima parte (a sexta)
  contÃ©m apenas os centavos, com duas casas
  }
  Str( Inteiro : 17 : 0, NumStr );
  TrioAtual    := 1;
  Inteiro      := Int( Inteiro / 100 ); { remove os centavos }

  { Preenche os espaÃ§os vazios com zeros para evitar erros de conversÃ£o }
  while NumStr[TrioAtual] = ' ' do begin
    NumStr[TrioAtual] := '0';
    Inc( TrioAtual );
  end;

  { Inicializa o conjunto como vazio }
  TriosUsados := [];
  NumTriosInt := 0; { NÃºmeros de trios da parte inteira (sem os centavos) }

  { Este loop gera os extensos de cada parte do nÃºmero }
  for TrioAtual := CasaDosTrilhoes to CasaDosCentavos do begin
    Val( Copy( NumStr, 3 * TrioAtual - 2, 3 ), RespostaN[TrioAtual], v );
    if RespostaN[TrioAtual] <> 0 then begin
      Resposta[TrioAtual] := Resposta[TrioAtual] +
      Extenso3em3( RespostaN[TrioAtual] );
      TriosUsados := TriosUsados + [ TrioAtual ];
      Inc( NumTriosInt );
      if RespostaN[TrioAtual] > 1 then begin
        Plural[TrioAtual] := True;
      end;
    end;
  end;

  if CasaDosCentavos in TriosUsados then
  Dec( NumTriosInt );

  { Gerar a resposta propriamente dita }
  NumStr := '';

  {
  Este trecho obriga que o nome da moeda seja sempre impresso no caso de
  haver uma parte inteira, qualquer que seja o valor.
  }
  if (Resposta[CasaDasCentenas]='') and ( Inteiro > 0 ) then begin
    Resposta[CasaDasCentenas] := ' ';
    Plural[CasaDasCentenas]   := True;
    TriosUsados := TriosUsados + [ CasaDasCentenas ];
  end;


  { Basta ser maior que um para que a palavra "real" seja escrita no plural }
  if Inteiro > 1 then
  Plural[CasaDasCentenas] := True;

  { Localiza o primeiro elemento }
  TrioAtual     := 0;
  TrioPosterior := ProximoTrio( TrioAtual );

  { Localiza o segundo elemento }
  TrioAtual     := TrioPosterior;
  TrioPosterior := ProximoTrio( TrioAtual );

  { Este loop vai percorrer apenas os trios preenchidos e saltar os vazios. }
  while TrioAtual <= CasaDosCentavos do begin
    { se for apenas cem, nÃ£o escrever 'cento' }
    if Resposta[TrioAtual] = 'CENTO' then
    Resposta[TrioAtual] := 'CEM';

    { Verifica se a resposta deve ser no plural ou no singular }
    if Resposta[TrioAtual] <> '' then begin
      NumStr := NumStr + Resposta[TrioAtual] + ' ';
      if plural[TrioAtual] then
      NumStr := NumStr + NoPlural[TrioAtual] + ' '
      else
      NumStr := NumStr + NoSingular[TrioAtual] + ' ';

      { Verifica a necessidade da particula 'e' para os nÃºmeros }
      if ( TrioAtual < CasaDosCentavos ) and ( Resposta[TrioPosterior] <> '' )
      and ( Resposta[TrioPosterior] <> ' ' ) then begin
        {
        Este trecho analisa diversos fatores e decide entre usar uma
        vÃ ou um "E", em funÃ§Ã£o de uma peculiaridade da lÃ. Veja
        os exemplos para compreender:
        - DOIS MIL, QUINHENTOS E CINQÃœENTA REAIS
        - DOIS MIL E QUINHENTOS REAIS
        - DOIS MIL E UM REAIS
        - TRÃŠS MIL E NOVENTA E CINCO REAIS
        - QUATRO MIL, CENTO E UM REAIS
        - UM MILHÃƒO E DUZENTOS MIL REAIS
        - UM MILHÃƒO, DUZENTOS MIL E UM REAIS
        - UM MILHÃƒO, OITOCENTOS E NOVENTA REAIS
        Obs.: Fiz o mÃ¡ximo esforÃ§o pra que o extenso soasse o mais natural
        possÃ em relaÃ§Ã£o Ã  lingua falada, mas se aparecer alguma
        situaÃ§Ã£o em que algo soe esquisito, peÃ§o a gentileza de me
        avisar.
        }
        if ( TrioAtual < CasaDosCentavos ) and
        ( ( NumTriosInt = 2 ) or ( TrioAtual = CasaDosMilhares ) ) and
        ( ( RespostaN[TrioPosterior] <= 100 ) or
        ( RespostaN[TrioPosterior] mod 100 = 0 ) ) then
        NumStr := NumStr + 'E '
        else
        NumStr := NumStr + ', ';
      end;
    end;

    { se for apenas trilhÃµes, bilhÃµes ou milhÃµes, acrescenta o 'de' }
    if ( NumTriosInt = 1 ) and ( Inteiro > 0 ) and ( TrioAtual <= CasaDosMilhoes ) then begin
      NumStr := NumStr + ' DE ';
    end;

    { se tiver centavos, acrescenta a partÃ 'e', mas somente se houver
    qualquer valor na parte inteira }
    if ( TrioAtual = CasaDasCentenas ) and ( Resposta[CasaDosCentavos] <> '' )
    and ( inteiro > 0 ) then begin
      NumStr := Copy( NumStr, 1, Length( NumStr ) - 2 ) + ' E ';
    end;

    TrioAtual     := ProximoTrio( TrioAtual );
    TrioPosterior := ProximoTrio( TrioAtual );
  end;

  { Eliminar algumas situaÃ§Ãµes em que o extenso gera excessos de espaÃ§os
  da resposta. Mero perfeccionismo... }
  NumStr := ReplaceSubstring( '  ', ' ', NumStr );
  NumStr := ReplaceSubstring( ' ,', ',', NumStr );

  if vMoeda then
    Result := NumStr else begin

    for i:= length(NumStr) downto 1 do begin
      if NumStr[i] = ' ' then begin
        vPos:= i;
        vTeste:= copy(NumStr,1,vPos-1);
        NumStr:= vTeste;
      end else break;
    end;
    for i:= length(NumStr) downto 1 do begin
      if NumStr[i] = ' ' then begin
        vPos:= i;
        vTeste:= copy(NumStr,1,vPos-1);
        Result:= vTeste;
        break;
      end;
    end;
  end;
end;

{End of Rotinas do Extenso}

function IsItVideo(aFileName: string): boolean;
  var
    vExt: string;
    vVideoExt: string;
    i: integer;
    vCount: integer;
  begin
    vVideoExt:='.avi;.mpeg;.mpeg1;.mpeg2;.mpeg4;.mpg;.wmv;.mp4;.flv;.mkv;.m4v;.m1v;.3gp;.3gpp;.m2v;.mod;.mpa;.mpe;.mpv2;.mov;.m2t;.mts;.mp4v;.3ga;.669;.divx;.dv;.f4v;.flv;.m4p;.rmvb;.vob';
    vCount:= Util.ContItensFromStrComaSep(vVideoExt);
    vExt:= ExtractFileExt(aFileName);
    for i:= 1 to vCount do
      if UpperCase(Util.GetItemFromStrComaSep(vVideoExt,i)) = uppercase(vExt) then begin
        result:= true;
        exit;
      end;
    result:= false;
  end;

function IsItAudio(aFileName: string): boolean;
  var
    vExt: string;
    vVideoExt: string;
    i: integer;
    vCount: integer;
  begin
    vVideoExt:='.mp3;.wav;.asf;.aac;.adt;.adts;.m4a;.mid;.rmi;.aif;.aifc;.aiff;.au;.snd;.mp2;.3ga;.a52;.ac3;.aob;.ape;.ogg;.wma;.flac;.gvi;.gxf;.it;.m3u8;.m4p;.mka;.mlp;.mpga;.oma;.opus;.pls;.qcp;.ra;.ram;.rec;.s3m;.sdp;.tta;.vlc;.voc;.vqf;.vro;.w64;.webm';
    vVideoExt:= vVideoExt+ ';.wv;.xa;.xesc;.xm;.xspf';
    vCount:= Util.ContItensFromStrComaSep(vVideoExt);
    vExt:= ExtractFileExt(aFileName);
    for i:= 1 to vCount do
      if UpperCase(Util.GetItemFromStrComaSep(vVideoExt,i)) = uppercase(vExt) then begin
        result:= true;
        exit;
      end;
    result:= false;
  end;

function IsItMMRK(aFileName: string): boolean;
  var
    vExt: string;
    vVideoExt: string;
    vCount: integer;
  begin
    vVideoExt:='.MMRK';
    vExt:= ExtractFileExt(aFileName);
    if vVideoExt = UpperCase(vExt) then begin
      result:= true;
      exit;
    end;
    result:= false;
  end;

function isItFolder(aString: string): string;
begin
  result:= 'None';
  if DirectoryExists(aString)
  then result:= 'FOLDER'
  else if(FileExists(aString))
        then result:= 'ARQUIVO';
end;

function nota(aVal: Integer): string;
begin
  case aVal of
  81..100: result:= 'Excelente';
  61..80: result:= 'Ótimo';
  41..60: result:= 'Muito bom';
  21..40: result:= 'Bom';
  1..20: result:= 'Ruim';
  0: result:= 'Péssimo';
  end;
end;



end.
