Buscar por:
Várias funções

Código
Unit LibFuncoes;

interface uses

   Windows, SysUtils, Classes, Forms, DBTables, Messages, stdctrls, Dialogs, dbctrls,

   Variants, FMain, ppComm, ppRelatv, ppDB, ppDBPipe, ppDBBDE, ppParameter,

   ppModule, raCodMod, ppBands, ppClass, ppCtrls, ppVar, ppPrnabl, ppCache,

   ppProd, ppReport, Urlmon, Winsock, Jpeg, Registry, IniFiles;

procedure ForcaFecharProgramas;

procedure CriaForm(TipoForm: TComponentClass; NomeForm: TForm; Rotina: string);

procedure FechaTabela(NomeForm: TForm);

function extenso(valor: real): string;

function IsWindowInMemory(WndTitle: string): Boolean;

function RetornaParam(NumPar: Integer): string;

function RetornaSigni(NumPar: Integer): string;

function SerialHD: string;

procedure VerificaDatas(Data_Inicial, Data_Final: TDateTime);

procedure VerificaNulos(Codigo: string; Unidade_Medida: Integer; Valor, Quantidade: Currency; Verifica_Quantidade: Boolean;

   EditCodigo, EditUnidade, EditQuantidade, EditValor: TDbEdit);

procedure RefreshQuery(Query: TQuery; Localizar: Boolean; Campo: string; Codigo: Variant);

procedure RefreshTabela(Query: TTable; Localizar: Boolean; Campo: string; Codigo: Variant);

function CalculaCnpjCpf(Numero: string): string;

function AdicionaData(Data: TDateTime): TDateTime;

procedure AlteraDataSis(Data: TDateTime);

function TestaCgc(xCGC: string): Boolean;

function ExecQuery(sComando: string; Proprietario: TComponent): variant;

function DownloadFile(Source, Dest: string): Boolean;

function mostrahora: string;

function mostradata: string;

function ValidaHora(Hora: string): boolean;

function Criptografar(Senha: string): string;

procedure MensagemErro(Titulo: PAnsiChar; Mensagem: PAnsiChar);

procedure MensagemInformacao(Titulo: PAnsiChar; Mensagem: PAnsiChar);

function MensagemConfirmacao(Titulo: PAnsiChar; Mensagem: PAnsiChar): Integer;

function UltDiaDoMes(Data: TDateTime): Word;

function Tempo(Secs: Integer): string;

function TimeInWindows: string;

function FreeDiskSpace(strDisk: string): string;

function WindowsVersion: string;

function ScreenResolution: string;

function ScrollState: string;

function NumState: string;

function CapsState: string;

function CompName: string;

function Language: string;

function UserName: string;

function SysDir: string;

function TmpDir: string;

function WinDir: string;

function GetIP: string;

function RemoveAcento(Str: string): string;

procedure CopiaArquivos(ArqEnt, ArqSai: string);

function LerParametroInteiro(Sessao: string; Chave: string; ValorPadrao: Integer): Integer;

function LerParametroString(Sessao: string; Chave: string; ValorPadrao: string): string;

function LerParametroBoleano(Sessao: string; Chave: string; ValorPadrao: Boolean): Boolean;

function LerParametroNumerico(Sessao: string; Chave: string; ValorPadrao: Currency): Currency;

function DiretorioWindows: string;

function ArquivoParametro: string;

function cpf(num: string): boolean;

//function MensagemDlg(txtMsg:String):boolean;

implementation

procedure CriaForm(TipoForm: TComponentClass; NomeForm: TForm; Rotina: string);

var

   i: Integer;

begin

   FrmMain.QryAcesso.Open;

   FrmMain.RotinaAtual := Rotina;

   if (FrmMain.LoginAtual = 'ADMIN') then

   begin

      if not (FrmMain.QryAcesso.Locate('LoginUsuario', 'ADMIN', [])) or (frmMain.Senha = 'ADMIN') then

      begin

         Application.CreateForm(TipoForm, NomeForm);

         FrmMain.NomeTela := NomeForm.Name + ',' + NomeForm.Caption;

         NomeForm.ShowModal;

         FechaTabela(NomeForm);

         NomeForm.Free;

      end

      else

      begin

         if FrmMain.QryAcesso.Locate('LoginUsuario;ChaveRotina', vararrayof([FrmMain.LoginAtual, Rotina]), []) then

         begin

            Application.CreateForm(TipoForm, NomeForm);

            if FrmMain.QryAcesso.FieldByName('Status').asString = 'LEITURA' then

               for i := 0 to NomeForm.ComponentCount - 1 do

                  if NomeForm.Components[i] is TTable then TTable(NomeForm.Components[i]).ReadOnly := true;

            FrmMain.NomeTela := NomeForm.Name + ',' + NomeForm.Caption;

            NomeForm.ShowModal;

            FechaTabela(NomeForm);

            NomeForm.Free;

         end;

      end;

   end

   else

   begin

      if FrmMain.QryAcesso.Locate('LoginUsuario;ChaveRotina', vararrayof([FrmMain.LoginAtual, Rotina]), []) then

      begin

         Application.CreateForm(TipoForm, NomeForm);

         if FrmMain.QryAcesso.FieldByName('Status').asString = 'LEITURA' then

            for i := 0 to NomeForm.ComponentCount - 1 do

               if NomeForm.Components[i] is TTable then TTable(NomeForm.Components[i]).ReadOnly := true;

         FrmMain.NomeTela := NomeForm.Name + ',' + NomeForm.Caption;

         NomeForm.ShowModal;

         FechaTabela(NomeForm);

         NomeForm.Free;

      end

      else

         MessageDlg('Você não tem permissão para acessar esta rotina! Contate o Administrador do Sistema.', mterror, [mbok], 0);

   end;

   FrmMain.QryAcesso.Close;

end;

//------------------------------------------------------------------------------

function IsWindowInMemory(WndTitle: string): Boolean;

var

   hSem: THandle;

   hWndMe: HWnd;

begin

   Result := False;

   hSem := CreateSemaphore(nil, 0, 1, 'NomeDoSemaforo');

   if (hSem <> 0) and (GetLastError() = ERROR_ALREADY_EXISTS) then

   begin

      CloseHandle(hSem);

      hWndMe := FindWindow(nil, PChar(WndTitle));

      SetWindowText(hWndMe, 'ii7it89lihtf');

      hWndMe := FindWindow(nil, PChar(WndTitle));

      if hWndMe <> 0 then

      begin

         if IsIconic(hWndMe) then

            ShowWindow(hWndMe, SW_SHOWNORMAL)

         else

            SetForegroundWindow(hWndMe);

      end;

      Result := True;

   end;

end;

function RetornaParam(NumPar: Integer): string;

var Arq: TextFile;

   Cont: Integer;

   Txt: string;

   I: Integer;

   WinDir: array[0..144] of char;

   DirWin: string;

begin

   GetWindowsDirectory(WinDir, 144);

   DirWin := StrPas(WinDir);

   cont := 0;

   if FileExists(DirWin + 'systemsice.ini') then AssignFile(Arq, DirWin + 'systemsice.ini');

   if FileExists(DirWin + 'systemsice.ini') then AssignFile(Arq, DirWin + 'systemsice.ini');

   Reset(Arq);

   ReadLn(Arq, Txt); //Serial do HD

   for i := 0 to FrmMain.NumEmpresa do

   begin

      ReadLn(Arq, Txt); //Caminho do data.dll

   end;

   AssignFile(Arq, Txt);

   Reset(Arq);

   while not Eof(Arq) do

   begin

      cont := cont + 1;

      if cont = NumPar then

      begin

         Read(Arq, Txt);

         Result := Txt;

      end;

      ReadLn(Arq);

   end;

   CloseFile(Arq);

end;

function SerialHD: string;

var Serial: DWord;

   DirLen, Flags: DWord;

   DLabel: array[0..11] of char;

begin

   GetVolumeInformation(PChar('C:'), dLabel, 12, @Serial, DirLen, Flags, nil, 0);

   Result := IntToHex(Serial, 8);

end;

procedure VerificaDatas(Data_Inicial, Data_Final: TDateTime);

begin

   if Data_Final < Data_Inicial then

   begin

      MessageDlg('Data Final não pode ser menor que Data Inicial!', mtinformation, [mbok], 0);

      abort;

   end;

end;

procedure VerificaNulos(Codigo: string; Unidade_Medida: Integer; Valor, Quantidade: Currency; Verifica_Quantidade: Boolean;

   EditCodigo, EditUnidade, EditQuantidade, EditValor: TDbEdit);

begin

   if Codigo = '' then

   begin

      MessageDlg('Preencha o Código do Produto!', mtInformation, [mbok], 0);

      EditCodigo.SetFocus;

      Abort;

   end;

   if Unidade_Medida <= 0 then

   begin

      MessageDlg('Preencha a Unidade de Medida!', mtInformation, [mbok], 0);

      EditUnidade.SetFocus;

      Abort;

   end;

   if Valor <= 0 then

   begin

      MessageDlg('Preencha o Valor Unitário!', mtInformation, [mbok], 0);

      EditValor.SetFocus;

      Abort;

   end;

   if Verifica_Quantidade then

      if Quantidade <= 0 then

      begin

         MessageDlg('Preencha a Quantidade!', mtInformation, [mbok], 0);

         EditQuantidade.SetFocus;

         Abort;

      end;

end;

procedure RefreshQuery(Query: TQuery; Localizar: Boolean; Campo: string; Codigo: Variant);

begin

   Query.Close;

   Query.Open;

   if Localizar then

   begin

      Query.Locate(Campo, Codigo, []);

   end;

end;

procedure RefreshTabela(Query: TTable; Localizar: Boolean; Campo: string; Codigo: Variant);

begin

   Query.Close;

   Query.Open;

   if Localizar then

   begin

      Query.Locate(Campo, Codigo, []);

   end;

end;

function extenso(valor: real): string;

var

   Centavos, Centena, Milhar, Texto, msg: string;

const

   Unidades: array[1..9] of string = ('Um', 'Dois', 'Tres', 'Quatro', 'Cinco', 'Seis', 'Sete', 'Oito', 'Nove');

   Dez: array[1..9] of string = ('Onze', 'Doze', 'Treze', 'Quatorze', 'Quinze', 'Dezesseis', 'Dezessete', 'Dezoito', 'Dezenove');

   Dezenas: array[1..9] of string = ('Dez', 'Vinte', 'Trinta', 'Quarenta', 'Cinquenta', 'Sessenta', 'Setenta', 'Oitenta', 'Noventa');

   Centenas: array[1..9] of string = ('Cento', 'Duzentos', 'Trezentos', 'Quatrocentos', 'Quinhentos', 'Seiscentos', 'Setecentos', 'Oitocentos', 'Novecentos');

   function ifs(Expressao: Boolean; CasoVerdadeiro, CasoFalso: string): string;

   begin

      if Expressao

         then Result := CasoVerdadeiro

      else Result := CasoFalso;

   end;

   function MiniExtenso(trio: string): string;

   var

      Unidade, Dezena, Centena: string;

   begin

      Unidade := '';

      Dezena := '';

      Centena := '';

      if (trio[2] = '1') and (trio[3] <> '0') then

      begin

         Unidade := Dez[strtoint(trio[3])];

         Dezena := '';

      end

      else

      begin

         if trio[2] <> '0' then Dezena := Dezenas[strtoint(trio[2])];

         if trio[3] <> '0' then Unidade := Unidades[strtoint(trio[3])];

      end;

      if (trio[1] = '1') and (Unidade = '') and (Dezena = '')

         then Centena := 'cem'

      else

         if trio[1] <> '0'

            then Centena := Centenas[strtoint(trio[1])]

         else Centena := '';

      Result := Centena + ifs((Centena <> '') and ((Dezena <> '') or (Unidade <> '')), ' e ', '')

         + Dezena + ifs((Dezena <> '') and (Unidade <> ''), ' e ', '') + Unidade;

   end;

begin

   if (valor > 999999.99) or (valor < 0) then

   begin

      msg := 'O valor está fora do intervalo permitido.';

      msg := msg + 'O número deve ser maior ou igual a zero e menor que 999.999,99.';

      msg := msg + ' Se não for corrigido o número não será escrito por extenso.';

      showmessage(msg);

      Result := '';

      exit;

   end;

   if valor = 0 then

   begin

      Result := '';

      Exit;

   end;

   Texto := formatfloat('000000.00', valor);

   Milhar := MiniExtenso(Copy(Texto, 1, 3));

   Centena := MiniExtenso(Copy(Texto, 4, 3));

   Centavos := MiniExtenso('0' + Copy(Texto, 8, 2));

   Result := Milhar;

   if Milhar <> '' then

      if copy(texto, 4, 3) = '000' then

         Result := Result + ' Mil Reais'

      else

         Result := Result + ' Mil, ';

   if (((copy(texto, 4, 2) = '00') and (Milhar <> '')

      and (copy(texto, 6, 1) <> '0')) or (centavos = ''))

      and (Centena <> '') then Result := Result + ' e ';

   if (Milhar + Centena <> '') then Result := Result + Centena;

   if (Milhar = '') and (copy(texto, 4, 3) = '001') then

      Result := Result + ' Real'

   else

      if (copy(texto, 4, 3) <> '000') then Result := Result + ' Reais';

   if Centavos = '' then

   begin

      if Result = ' e cem Reais' then

         Result := 'Cem Reais.'

      else

         Result := Result + '.';

      Exit;

   end

   else

   begin

      if Milhar + Centena = '' then

         Result := Centavos

      else

         Result := Result + ', e ' + Centavos;

      if (copy(texto, 8, 2) = '01') and (Centavos <> '') then

         Result := Result + ' Centavo.'

      else

         Result := Result + ' Centavos.';

   end;

end;

function RetornaSigni(NumPar: Integer): string;

var Arq: TextFile;

   Cont: Integer;

   Txt: string;

   WinDir: array[0..144] of char;

   DirWin: string;

begin

   GetWindowsDirectory(WinDir, 144);

   DirWin := StrPas(WinDir);

   if FileExists(DirWin + 'systemsspar.dll') then

   begin

      cont := 0;

      AssignFile(Arq, DirWin + 'systemsspar.dll');

      Reset(Arq);

      while not Eof(Arq) do

      begin

         cont := cont + 1;

         if cont = NumPar then

         begin

            Read(Arq, Txt);

            Result := Txt;

         end;

         ReadLn(Arq);

      end;

      CloseFile(Arq);

   end;

end;

function CalculaCnpjCpf(Numero: string): string;

var

   i, j, k, Soma, Digito: Integer;

   CNPJ: Boolean;

begin

   Result := Numero;

   case Length(Numero) of

      9: CNPJ := False;

      12: CNPJ := True;

   else

      Exit;

   end;

   for j := 1 to 2 do

   begin

      k := 2;

      Soma := 0;

      for i := Length(Result) downto 1 do

      begin

         Soma := Soma + (Ord(Result[i]) - Ord('0')) * k;

         Inc(k);

         if (k > 9) and CNPJ then

            k := 2;

      end;

      Digito := 11 - Soma mod 11;

      if Digito >= 10 then

         Digito := 0;

      Result := Result + Chr(Digito + Ord('0'));

   end;

end;

function AdicionaData(Data: TDateTime): TDateTime;

begin

   Data := Data - 1;

   Result := Data;

end;

procedure FechaTabela(NomeForm: TForm);

var i: integer;

begin

   for i := 0 to NomeForm.ComponentCount - 1 do

   begin

      if NomeForm.Components[i] is TTable then

         TTable(NomeForm.Components[i]).Close;

      if NomeForm.Components[i] is TQuery then

         TQuery(NomeForm.Components[i]).Close;

   end;

end;

procedure AlteraDataSis(Data: TDateTime);

var SysTime: TSystemTime;

begin

   DateTimeToSystemTime(Data, SysTime);

   SetLocalTime(SysTime);

end;

procedure ForcaFecharProgramas;

begin

   ExitWindowsEx(EWX_FORCE, 0);

end;

function TestaCgc(xCGC: string): Boolean;

var

   d1, d4, xx, nCount, fator, resto, digito1, digito2: Integer;

   Check: string;

begin

   d1 := 0; d4 := 0; xx := 1;

   for nCount := 1 to Length(xCGC) - 2 do

   begin

      if Pos(Copy(xCGC, nCount, 1), '/-.') = 0 then

      begin

         if xx < 5 then fator := 6 - xx

         else fator := 14 - xx;

         d1 := d1 + StrToInt(Copy(xCGC, nCount, 1)) * fator;

         if xx < 6 then fator := 7 - xx

         else fator := 15 - xx;

         d4 := d4 + StrToInt(Copy(xCGC, nCount, 1)) * fator;

         xx := xx + 1;

      end;

   end;

   resto := (d1 mod 11);

   if resto < 2 then digito1 := 0

   else digito1 := 11 - resto;

   d4 := d4 + 2 * digito1;

   resto := (d4 mod 11);

   if resto < 2 then digito2 := 0

   else digito2 := 11 - resto;

   Check := IntToStr(Digito1) + IntToStr(Digito2);

   if Check <> copy(xCGC, succ(length(xCGC) - 2), 2) then

   Begin

    messagedlg('CNPJ inválido! A não correção pode gerar problemas'+#13+' na emissão do sintegra.',MtInformation,[mbOk],0);

    Result := False;

   end

   else begin

     Result := True;

   end;

end;

function ExecQuery(sComando: string; Proprietario: TComponent): variant;

var

   qryExec: TQuery;

begin

   qryExec := TQuery.create(Proprietario);

   qryExec.DatabaseName := 'sige';

   qryExec.SQL.Add(sComando);

   qryExec.Open;

   result := qryExec.Fields[0].Value;

   qryExec.close;

   FreeAndNil(qryExec);

end;

// ---------------------------------------------------------------------------------------

function ValidaHora(Hora: string): boolean;

begin

   ValidaHora := false;

   if (StrToInt(Hora[1]) < 0) or (StrToInt(Hora[1]) > 2) then

      ValidaHora := true;

   if (StrToInt(Hora[2]) < 0) then

      ValidaHora := true;

   if (StrToInt(Hora[2]) > 4) and (StrToInt(Hora[1]) > 2) then

      ValidaHora := true;

   if (StrToInt(Hora[4]) > 6) then

      ValidaHora := true;

   if (Hora[1] = '') or (Hora[2] = '') or (Hora[3] = '') or (Hora[4] = '') or (Hora[5] = '') then

      ValidaHora := true;

   if (Hora[1] = ' ') or (Hora[2] = ' ') or (Hora[3] = ' ') or (Hora[4] = ' ') or (Hora[5] = ' ') then

      ValidaHora := true;

end;

// ---------------------------------------------------------------------------------------

function Criptografar(

   Senha: string): string;

const

   Chave: string = 'As';

var

   x, y: Integer;

   NovaSenha: string;

begin

   for x := 1 to Length(Chave) do

   begin

      NovaSenha := '';

      for y := 1 to Length(Senha) do

         NovaSenha := NovaSenha + chr((Ord(Chave[x]) xor Ord(Senha[y])));

      Senha := NovaSenha;

   end;

   result := Senha;

end;

// ---------------------------------------------------------------------------------------

procedure MensagemErro(Titulo: PAnsiChar; Mensagem: PAnsiChar);

begin

   Application.MessageBox(Mensagem, Titulo, MB_OK + MB_ICONERROR);

end;

// ---------------------------------------------------------------------------------------

procedure MensagemInformacao(Titulo: PAnsiChar; Mensagem: PAnsiChar);

begin

   Application.MessageBox(Mensagem, Titulo, MB_OK + MB_ICONQUESTION);

end;

// ---------------------------------------------------------------------------------------

function MensagemConfirmacao(Titulo: PAnsiChar; Mensagem: PAnsiChar): Integer;

begin

   result := Application.MessageBox(Mensagem, Titulo, MB_YESNO + MB_ICONEXCLAMATION);

end;

// ---------------------------------------------------------------------------------------

function UltDiaDoMes(Data: TDateTime): Word;

var

   d, m, a: Word;

   dt: TDateTime;

begin

   DecodeDate(Data, a, m, d);

   Inc(m);

   if m = 13 then

   begin

      m := 1;

   end;

   dt := EncodeDate(a, m, 1);

   dt := dt - 1;

   DecodeDate(dt, a, m, d);

   Result := d;

end;

// ---------------------------------------------------------------------------------------

function Tempo(Secs: Integer): string;

var

   Hrs, Min: Word;

begin

   Hrs := Secs div 3600;

   Secs := Secs mod 3600;

   Min := Secs div 60;

   //     Secs   := Secs mod 60;

   Result := FormatFloat('00', hrs) + ':' + FormatFloat('00', min);

end;

// ---------------------------------------------------------------------------------------

function DownloadFile(Source, Dest: string): Boolean;

begin

   try

      Result := UrlDownloadToFile(nil, PChar(source), PChar(Dest), 0, nil) = 0;

   except

      Result := False;

   end;

end;

// ---------------------------------------------------------------------------------------

function mostrahora: string;

begin

   mostrahora := timetostr(time);

end;

// ---------------------------------------------------------------------------------------

function mostradata: string;

var

   dthoje: tdatetime;

   diasemana: integer;

   strdiasemana: string;

begin

   dthoje := date;

   diasemana := dayofweek(dthoje);

   case diasemana of

      1: strdiasemana := 'Domingo ';

      2: strdiasemana := 'Segunda-feira ';

      3: strdiasemana := 'Terça-feira ';

      4: strdiasemana := 'Quarta-feira ';

      5: strdiasemana := 'Quinta-feira ';

      6: strdiasemana := 'Sexta-feira ';

      7: strdiasemana := 'Sábado ';

   end;

   mostradata := strdiasemana + ' ' + datetostr(dthoje);

end;

//------------------------------------------------------------------------------

function WinDir: string;

var

   intLen: integer;

   strBuffer: string;

begin

   SetLength(strBuffer, 1000);

   intLen := GetWindowsDirectory(PChar(strBuffer), 1000);

   WinDir := Trim(Copy(strBuffer, 1, intLen));

end;

//------------------------------------------------------------------------------

function SysDir: string;

var

   intLen: integer;

   strBuffer: string;

begin

   SetLength(strBuffer, 1000);

   intLen := GetSystemDirectory(PChar(strBuffer), 1000);

   SysDir := Trim(Copy(strBuffer, 1, intLen));

end;

//------------------------------------------------------------------------------

function TmpDir: string;

var

   intLen: integer;

   strBuffer: string;

begin

   SetLength(strBuffer, 1000);

   intLen := GetTempPath(1000, PChar(strBuffer));

   TmpDir := Trim(Copy(strBuffer, 1, intLen));

end;

//------------------------------------------------------------------------------

function UserName: string;

const

   cnMaxUserNameLen = 254;

var

   sUserName: string;

   dwUserNameLen: DWord;

begin

   dwUserNameLen := cnMaxUserNameLen - 1;

   SetLength(sUserName, cnMaxUserNameLen);

   GetUserName(PChar(sUserName), dwUserNameLen);

   SetLength(sUserName, dwUserNameLen);

   UserName := sUserName;

end;

//------------------------------------------------------------------------------

function Language: string;

var

   LanguageID: LangID;

   Lang: array[0..100] of char;

begin

   LanguageID := GetSystemDefaultLangID;

   VerLanguageName(LanguageID, Lang, 100);

   Language := string(Lang);

end;

//------------------------------------------------------------------------------

function CompName: string;

var

   buffer: array[0..MAX_COMPUTERNAME_LENGTH + 1] of Char;

   length: Cardinal;

begin

   length := MAX_COMPUTERNAME_LENGTH + 1;

   GetComputerName(@buffer, length);

   CompName := buffer;

end;

//------------------------------------------------------------------------------

function CapsState: string;

begin

   if Odd(GetKeyState(VK_CAPITAL)) then

      CapsState := 'On'

   else

      CapsState := 'Off';

end;

//------------------------------------------------------------------------------

function NumState: string;

begin

   if Odd(GetKeyState(VK_NUMLOCK)) then

      NumState := 'On'

   else

      NumState := 'Off';

end;

//------------------------------------------------------------------------------

function ScrollState: string;

begin

   if Odd(GetKeyState(VK_SCROLL)) then

      ScrollState := 'On'

   else

      ScrollState := 'Off';

end;

//------------------------------------------------------------------------------

function ScreenResolution: string;

var

   X, Y: longint;

begin

   X := GetSystemMetrics(SM_CXSCREEN);

   Y := GetSystemMetrics(SM_CYSCREEN);

   ScreenResolution := Format('%dx%d', [X, Y]);

end;

//------------------------------------------------------------------------------

function WindowsVersion: string;

var

   Info: _OSVERSIONINFOA;

   cSystem: string;

begin

   Info.dwOSVersionInfoSize := SizeOf(Info);

   GetVersionEx(Info);

   if Info.dwPlatformId = VER_PLATFORM_WIN32_NT then

      cSystem := 'Windows NT '

   else if Info.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS then

      cSystem := 'Windows 95/98 '

   else if Info.dwPlatformId = VER_PLATFORM_WIN32s then

      cSystem := 'Win32s '

   else

      cSystem := 'Unknown';

   cSystem := cSystem + IntToStr(Info.dwMajorVersion) + '.' + IntToStr(Info.dwMinorVersion);

   cSystem := cSystem + ' ' + Trim(IntToStr(Info.dwBuildNumber)) + ' ' + Trim(Info.szCSDVersion); ;

   WindowsVersion := cSystem;

end;

//------------------------------------------------------------------------------

function FreeDiskSpace(strDisk: string): string;

var

   Bytes, Sectors: Cardinal;

   freeClusters, totalClusters: Cardinal;

begin

   GetDiskFreeSpace(PChar(strDisk), Sectors, Bytes, freeClusters, totalClusters);

   FreeDiskSpace := FormatFloat('###,###', (Sectors * Bytes * freeClusters));

end;

//------------------------------------------------------------------------------

function TimeInWindows: string;

begin

   TimeInWindows := FormatFloat('0#', GetTickCount div 1000 div 60);

end;

//------------------------------------------------------------------------------

function GetIP: string;

// Declare a Winsock na clausula uses da unit

var

   WSAData: TWSAData;

   HostEnt: PHostEnt;

   Name: string;

begin

   WSAStartup(2, WSAData);

   SetLength(Name, 255);

   Gethostname(PChar(Name), 255);

   SetLength(Name, StrLen(PChar(Name)));

   HostEnt := gethostbyname(PChar(Name));

   with HostEnt^ do

   begin

      Result := Format('%d.%d.%d.%d', [Byte(h_addr^[0]), Byte(h_addr^[1]), Byte(h_addr^[2]), Byte(h_addr^[3])]);

   end;

   WSACleanup;

end;

//------------------------------------------------------------------------------

function RemoveAcento(Str: string): string;

const

   ComAcento = 'àâêôûãõáéíóúçüÀÂÊÔÛÃÕÁÉÍÓÚÇÜ';

   SemAcento = 'aaeouaoaeioucuAAEOUAOAEIOUCU';

var

   x: Integer;

begin

   ;

   for x := 1 to Length(Str) do

      if Pos(Str[x], ComAcento) <> 0 then

         Str[x] := SemAcento[Pos(Str[x], ComAcento)];

   Result := Str;

end;

//------------------------------------------------------------------------------

procedure CopiaArquivos(ArqEnt, ArqSai: string);

var

   StrmEnt, StrmSai: TFileStream;

begin

   StrmEnt := TFileStream.Create(ArqEnt, fmOpenRead);

   try

      StrmSai := TFileStream.Create(ArqSai, fmOpenWrite or

         fmCreate);

      try

         StrmSai.CopyFrom(StrmEnt, StrmEnt.Size);

      finally

         StrmSai.Free;

      end;

   finally

      StrmEnt.Free;

   end;

end;

//------------------------------------------------------------------------------

function UsuarioLogado: string;

var Registro: TRegistry;

begin

   Registro := TRegistry.Create;

   Registro.RootKey := HKEY_LOCAL_MACHINE;

   if Registro.OpenKey('NetworkLogon', false) then

      result := Registro.ReadString('username');

   Registro.Free;

end;

// -----------------------------------------------------------------------------

function LerParametroInteiro(Sessao: string; Chave: string; ValorPadrao: Integer): Integer;

var arquivo: TIniFile;

   valor_retorno: Integer;

begin

   try

      Arquivo := TIniFile.Create('c:siceparam.ini');

      valor_retorno := Arquivo.ReadInteger(Sessao, Chave, ValorPadrao);

   finally

      Arquivo.Free;

   end;

   try

      result := valor_retorno;

   except

      MensagemErro('Erro', 'Ocorreu um erro na tentativa de ler o arquivo de parâmetros do Sistema.');

   end;

end;

// -----------------------------------------------------------------------------

function LerParametroString(Sessao: string; Chave: string; ValorPadrao: string): string;

var arquivo: TIniFile;

   valor_retorno: string;

begin

   try

      Arquivo := TIniFile.Create('c:siceparam.ini');

      valor_retorno := Arquivo.ReadString(Sessao, Chave, ValorPadrao);

   finally

      Arquivo.Free;

   end;

   try

      result := valor_retorno;

   except

      MensagemErro('Erro', 'Ocorreu um erro na tentativa de ler o arquivo de parâmetros do Sistema.');

   end;

end;

// -----------------------------------------------------------------------------

function LerParametroBoleano(Sessao: string; Chave: string; ValorPadrao: Boolean): Boolean;

var arquivo: TIniFile;

   valor_retorno: Boolean;

begin

   try

      Arquivo := TIniFile.Create('c:siceparam.ini');

      valor_retorno := Arquivo.ReadBool(Sessao, Chave, ValorPadrao);

   finally

      Arquivo.Free;

   end;

   try

      result := valor_retorno;

   except

      MensagemErro('Erro', 'Ocorreu um erro na tentativa de ler o arquivo de parâmetros do Sistema.');

   end;

end;

// -----------------------------------------------------------------------------

function DiretorioWindows: string;

var WinDir: array[0..144] of char;

   DirWin: string;

begin

   GetWindowsDirectory(WinDir, 144);

   DirWin := StrPas(WinDir);

   result := DirWin;

end;

// -----------------------------------------------------------------------------

function ArquivoParametro: string;

var Arq: TextFile;

   arquivo: string;

begin

   if FileExists(DiretorioWindows + 'systemsice.ini') then

   begin

      AssignFile(Arq, DiretorioWindows + 'systemsice.ini');

      Reset(Arq);

      ReadLn(Arq, arquivo);

      ReadLn(Arq, arquivo);

      ReadLn(Arq, arquivo);

   end

   else

   begin

      MensagemErro('Erro', 'Não foi possível localizar o arquivo de configurações do Sistema.');

   end;

   result := Arquivo;

end;

// -----------------------------------------------------------------------------

function LerParametroNumerico(Sessao: string; Chave: string; ValorPadrao: Currency): Currency;

var arquivo: TIniFile;

   valor_retorno: Currency;

begin

   try

      Arquivo := TIniFile.Create('c:siceparam.ini');

      valor_retorno := Arquivo.ReadFloat(Sessao, Chave, ValorPadrao);

   finally

      Arquivo.Free;

   end;

   try

      result := valor_retorno;

   except

      MensagemErro('Erro', 'Ocorreu um erro na tentativa de ler o arquivo de parâmetros do Sistema.');

   end;

end;

// -----------------------------------------------------------------------------

function cpf(num: string): boolean;

var

N: array[1..9] of Integer;

D: array[1..2] of Integer;

I: Integer;

digitado, calculado: string;

begin

D[1]:=0;

for I:= 1 to 9 do

begin

N[I]:= StrToInt(num[I]);

D[1]:= D[1]+(11-I)*N[I];

end;

D[1]:=11-(D[1] mod 11);

if D[1] >= 10 then D[1]:= 0;

D[2]:=0;

for I:= 1 to 9 do

D[2]:= D[2]+(12-I)*N[I];

D[2]:= D[2]+D[1]*2;

D[2]:=11-(D[2] mod 11);

if D[2] >= 10 then D[2]:= 0;

calculado:= IntToStr(D[1])+IntToStr(D[2]);

digitado:= num[10]+num[11];

if (calculado=digitado) then

cpf:=true

else cpf:=false;

end;

//------------------------------------------------------------------------------

Function Mascara_Inscricao( Inscricao, Estado : String ) : String; Var

Mascara : String;

Contador_1 : Integer;

Contador_2 : Integer;

Begin

  Mascara := '***********'; { AL/AP/ES/MA/MS/PE/TO }

  IF Estado = 'AC' Then Mascara := '**.***.***/***-**' ;

  IF Estado = 'AM' Then Mascara := '**.***.***-*' ;

  IF Estado = 'BA' Then Mascara := '******-**' ;

  IF Estado = 'CE' Then Mascara := '********-*' ;

  IF Estado = 'DF' Then Mascara := '***********-**' ;

  IF Estado = 'GO' Then Mascara := '**.***.***-*' ;

  IF Estado = 'MT' Then Mascara := '**********-*' ;

  IF Estado = 'MG' Then Mascara := '***.***.***-****' ;

  IF Estado = 'PA' Then Mascara := '**-******-*' ;

  IF Estado = 'PB' Then Mascara := '********-*' ;

  IF Estado = 'PR' Then Mascara := '********-**' ;

  IF Estado = 'PE' Then Mascara := '**.*.***.*******-*';

  IF Estado = 'RJ' Then Mascara := '**.***.**-*' ;

  IF Estado = 'RN' Then Mascara := '**.***.***-*' ;

  IF Estado = 'RS' Then Mascara := '***/*******' ;

  IF Estado = 'RO' Then Mascara := '***.*****-*' ;

  IF Estado = 'RR' Then Mascara := '********-*' ;

  IF Estado = 'SC' Then Mascara := '***.***.***' ;

  IF Estado = 'SP' Then Mascara := '***.***.***.***' ;

  IF Estado = 'SE' Then Mascara := '*********-*' ;

  Contador_2 := 1;

  Result := '';

  Mascara := Mascara + '****';

  For Contador_1 := 1 To Length( Mascara ) Do Begin

  IF Copy( Mascara, Contador_1, 1 ) = '*' Then Result := Result + Copy( Inscricao, Contador_2, 1 );

  IF Copy( Mascara, Contador_1, 1 ) <> '*' Then Result := Result + Copy( Mascara , Contador_1, 1 );

  IF Copy( Mascara, Contador_1, 1 ) = '*' Then Contador_2 := Contador_2 + 1;

  End;

  Result := Trim( Result );

end;

//------------------------------------------------------------------------------

//Baseado numa procedure que encontrei no Planeta Delphi, modifiquei para esta

//função que retorna valor true no casa de pressionar SIM e false se pressionar

//NÃO. Traduz os botões mbYes e mbNo de uma forma bem simples.

//Exemplo:

{

function MensagemDlg(txtMsg:String):boolean;

var Mensagem:TForm;

begin

//Cria a janela de mensagem

Mensagem:=createmessagedialog(txtMsg,MtConfirmation,[MbYes,MbNo]);

//Trazur o titulo da mensagem

Mensagem.Caption:='Confirmação';

//Traduz os botões da caixa de mensagem

(Mensagem.FindComponent('Yes') as TButton).Caption:='Sim';

(Mensagem.FindComponent('No') as TButton).Caption:='Não';

//Exibr a caixa de mensagem

Mensagem.ShowModal;

//Verifica aqul botão foi pressionado

If Mensagem.ModalResult= mryes then result:=true; //Botão Sim

If Mensagem.ModalResult= mrno then result:=false; //Botão Não

end;

}

end.