Analitcs

Pesquisar no conteúdo do blog.atlabs.com.br

quarta-feira, 31 de outubro de 2012

DELPHI - Retornando Texto com valores separados por caractere delimitador (CommaText)

Reações: 
Function GetCommaText(S, Delimiter : String; ColumnIndex : Integer) : String;
var
  StrL : TStringList;
begin
  StrL := TStringList.Create;
  try
    StrL.Text := StringReplace(S, Delimiter, #13#10, [rfReplaceAll, rfIgnoreCase]);
      if StrL.Count <= ColumnIndex then
      Result    := ''
      else
      Result    := StrL.Strings[ColumnIndex];
  finally
    FreeAndNil(StrL);
  end;
end;

(* Usando a função

 Adicionar 3 Edits com os nomes de EdtV1, EdtV2, EdtV3 e um botão, com o evento de onclick conforme abaixo*)

procedure TForm1.Button1Click(Sender: TObject);
Const
  S = 'TextoColuna1;TextoColuna2   ;   TextoColuna3';
begin
  EdtV1.Text := GetCommaText(S, ';', 0);
  EdtV2.Text := GetCommaText(S, ';', 1);
  EdtV3.Text := GetCommaText(S, ';', 2);
end;

segunda-feira, 15 de outubro de 2012

DELPHI - Função de String para Hexadecimal / Hexadecimal para String

Reações: 
function StringToHex (S : string) : string;
var
  Str : String;
  i   : Integer;
begin
  for I := 0 to Length(S) - 1 do
  begin
    Str := Str + IntToHex(Ord(S[I + 1]), 2) + ' ';
  end;
  Delete(Str, Length(Str), 1);
  Result := Str;
end;

function HexToString(S : string) : string;
var
  Str : String;
  i   : Integer;
begin
  I := 1;
  while I <= Length(S) do
  begin
    Str := Str + Char(StrToInt('$' + Copy(S, I, 2)));
    I := I + 3;
  end;
  Result := Str;
end;

sábado, 6 de outubro de 2012

WINDOWS - Ferramenta de Listagem de Processos - Process Explorer

Reações: 
Ferramenta de Exibição Detalhada de Processos do Windows - 100% Free!!!!

Mais Informações:
http://technet.microsoft.com/en-us/sysinternals/bb896653.aspx


Download:
http://download.sysinternals.com/files/ProcessExplorer.zip


Download Direto do Blog (esses caras tem mania de tirar o download do ar, ou cobrar pela ferramenta quando de torna famosa)
http://www.atlabs.com.br/blog/download/ProcessExplorer.zip

GERAL - Obrigado a todos!

Reações: 
Obrigado a todos os que acessaram e utilizaram-se dos códigos fonte...


Espero ter ajudado, e espero postar e ajudar cada dia mais pessoas... Abraços!!!

WINDOWS - Windows 7 - Desativar e Excluir Arquivo de Hibernação - Hiberfil.sys

Reações: 
Na instalação do windows seven a hibernação fica ativada como padrão e quando é desativada no painel de controle o arquivo hiberfil.sys que é gerado quando está ativado não é excluído. O problema que o arquivo tem o mesmo tamanho da quantidade de ram e é um espaço ocupado desnecessário. Para desativar é simples:

1– Menu iniciar
2 – CMD
3 – Rodar como administrador
4 – digite o comando e dê enter: POWERCFG -H OFF
Simples e fácil, Agora ficará desativada a hibernação e o arquivo será excluído e você tera 3GB mais livre no seu HD.


Retirado do Site:
http://infornews.org/2010/03/windows-7-%E2%80%93-desativar-excluir-arquivo-de-hibernacao-hiberfil-sys/

quinta-feira, 4 de outubro de 2012

DELPHI - Função - Copiar até o 1º Espaço da String

Reações: 
// Função - Copiar até o 1º Espaço da String
  Function CopiaAteEspaco(S : String) : String;
  var
    L : Integer;
  begin
    L := Pos(' ', S);
    if L <= 0 then // Caso não haja espaço
      L := MaxInt; // Iguala a Variavel ao Maior Inteiro Definido Pelo Sistema
    Result := Copy(S, 1, L - 1);
  end;

WINDOWS - Process Explorer - Ferramenta Microsoft de Analise de Processos

Reações: 
http://technet.microsoft.com/en-us/sysinternals/bb896653.aspx

quarta-feira, 3 de outubro de 2012

DELPHI - Teste de Conexão - TCP Port - Indy 10

Reações: 
// Procurei na internet e não achei

//Segue abaixo:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls

  , IdBaseComponent, IdComponent // Units Base
  , IdTCPConnection, IdTCPClient // Unit TCP Client
  ;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    Function TestPortTCP(Host : String; Port : Word; Timeout : Integer = 3000) : Boolean;
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

// FUNÇÃO DE CONEXÂO DE PORTA - TCP PORT TEST DELPHI - Indy 10

function TForm1.TestPortTCP_ATLABS(Host: String; Port: Word;
  Timeout: Integer): Boolean;
var
  IdTCPClient: TIdTCPClient;
begin
  try
    Result := False;
    IdTCPClient := TIdTCPClient.Create(Nil);
    IdTCPClient.ReadTimeout := Timeout;
    IdTCPClient.Host := Host;
    IdTCPClient.Port := Port;
    try
    IdTCPClient.Connect;
    except
      IdTCPClient.Disconnect;
      Result := False;
      Exit;
    end;
    IdTCPClient.Disconnect;
    Result := True; // Passou pela conexão
  finally
    FreeAndNil(IdTCPClient);
  end;
end;
 

// TESTANDO!!!!
procedure TForm1.Button1Click(Sender: TObject);
begin
  if TestPortTCP_ATLABS('localhost', 80, 1000) then
  ShowMessage('OK')
  Else
  ShowMessage('Erro');
end;

end.


//ACONSELHO FORÇAR O TESTE COM UMA PORTA Q N ESTEJA ABERTA: 65535 por EX.

segunda-feira, 1 de outubro de 2012

DELPHI - Função de Preenchimento de Caractere Direita

Reações: 
Function PreencheCaracDir(Str, Carac :String; Qtd : Integer) : String;
var
  i : Integer;
  S : String;
begin
  Carac := Carac[1]; // Pega somente o primeiro caractere enviado
  Result := Str;
  if Length(Str) = Qtd then
    Exit;
  if Length(Str) > Qtd then
  begin
    Result := Copy(Str, 1, Qtd);
    Exit;
  end;
  For I := 1 to Qtd do
  begin
    S := S + Carac;
    if Length(S + Str) = Qtd then
    begin
      Result := Str +S;
      Break;
    End;
  end;
end;

//Uso:

Edit1.Text := PreencheCaracDir(Edit1.Text, '0', 14);

DELPHI - Retirando Caracteres a Direita

Reações: 
function TrimCaracRight(Carac: String;const S: string): string;
var
  I: Integer;
begin
  I := Length(S);
  while (I > 0) and (S[I] <= Carac) do Dec(I);
  Result := Copy(S, 1, I);
end;

DELPHI - Retirarndo Caracteres a Esquerda

Reações: 
function TrimCaracLeft(Carac: String; const S: string): string;
var
  I, L: Integer;
begin
  Carac := Carac[1];
  L := Length(S);
  I := 1;
  while (I <= L) and (S[I] <= Carac) do Inc(I);
  Result := Copy(S, I, Maxint);
end;

DELPHI - Função de Preenchimento de Caractere Esquerda

Reações: 
Function PreencheCaracEsq(Str, Carac :String; Qtd : Integer) : String;
var
  i : Integer;
  S : String;
begin
  Carac := Carac[1]; // Pega somente o primeiro caractere enviado
  Result := Str;
  if Length(Str) = Qtd then
    Exit;
  if Length(Str) > Qtd then
  begin
    Result := Copy(Str, 1, Qtd);
    Exit;
  end;
  For I := 1 to Qtd do
  begin
    S := S + Carac;
    if Length(S + Str) = Qtd then
    begin
      Result := S + Str;
      Break;
    End;
  end;
end;

//Uso:

Edit1.Text := PreencheCaracEsq(Edit1.Text, '0', 14);

DELPHI - Validação CNPJ

Reações: 
// Adequada a função de CPF

Function ValidacaoCNPJ(CNPJ:string):boolean;
var
  I               : integer;
  Want            : char;
  Wvalid          : boolean;
  Wdigit1,Wdigit2 : integer;
  Function StrNumber(S : String) : String;
  var
    X : Integer;
  begin
    Result := '';
    For X := 1 To Length(S) do
    begin
      Case Char(S[X]) of
        '0'..'9' : Result := Result + S[X];
      End;
    end;
  end;
begin
  Wdigit1 := 0;
  Wdigit2 := 0;
  Want    := CNPJ[1];//variavel para testar se o CNPJ é repetido como 111.111.111-11
  CNPJ := StrNumber(CNPJ); // Limpa o que não for numero
  if Length(CNPJ) < 14 then
  begin
    Result := False;
    exit;
  end;
  //testar se o CNPJ é repetido como 111.111.111-11
  for I := 1 to length(CNPJ) do
  begin
    if CNPJ[i] <> Want then
    begin
      Wvalid := True;  // se o CNPJ possui um digito diferente ele passou no primeiro teste
      Break;
    end;
  end;
  // se o CNPJ é composto por numeros repetido retorna falso
  if not Wvalid then
  begin
    Result := False;
    Exit;
  end;
  //executa o calculo para o primeiro verificador
  for i := 1 to 12 do
  begin
    if I+1 <= 9 then
      Wdigit1 := Wdigit1 + (StrToInt(CNPJ[13-i])*(I+1))
    else
    if I+1 > 9 then
      Wdigit1 := Wdigit1 + (StrToInt(CNPJ[13-i])*(I-7));
  end;
  Wdigit1:= 11 - (Wdigit1 mod 11);
  if Wdigit1 >= 10 then Wdigit1 := 0;
  //verifica se o 1° digito confere
  if IntToStr(Wdigit1) <> CNPJ[13] then
  begin
    Result := false;
    Exit;
  end;
  Wdigit2 := Wdigit1 * 2;
  for i := 1 to 12 do
  begin
    if I <= 7 then
      Wdigit2 := Wdigit2 + (StrToInt(CNPJ[13-i])*(I+2))
    else
    if I > 7 then
      Wdigit2 := Wdigit2 + (StrToInt(CNPJ[13-i])*(I-6));
  end;
  Wdigit2 := 11 - (Wdigit2 mod 11);
  if Wdigit2 >= 10 then Wdigit2 := 0;
  // confere o 2° digito verificador
  if IntToStr(Wdigit2) <> CNPJ[14] then
  begin
    Result := False;
    Exit;
  end;
  //se chegar até aqui o CNPJ é valido
  Result := True;
end;


// Usando:
  if ValidacaoCNPJ(Edit1.Text) then
    ShowMessage('Válido')
  else
    ShowMessage('Invalido');

DELPHI - Validação CPF

Reações: 
//Retirei do planeta delphi, identei e criei função de limpeza de caracteres:

Function ValidacaoCPF(CPF:string):boolean;
var
  I               : integer;
  Want            : char;
  Wvalid          : boolean;
  Wdigit1,Wdigit2 : integer;
  Function StrNumber(S : String) : String;
  var
    X : Integer;
  begin
    Result := '';
    For X := 1 To Length(S) do
    begin
      Case Char(S[X]) of
        '0'..'9' : Result := Result + S[X];
      End;
    end;
  end;
begin
  Wdigit1 := 0;
  Wdigit2 := 0;
  Want    := CPF[1];//variavel para testar se o cpf é repetido como 111.111.111-11
  CPF := StrNumber(CPF); // Limpa o que não for numero
  if Length(CPF) < 11 then
  begin
    Result := False;
    exit;
  end;
  //testar se o cpf é repetido como 111.111.111-11
  for I := 1 to length(CPF) do
  begin
    if CPF[i] <> Want then
    begin
      Wvalid := True;  // se o cpf possui um digito diferente ele passou no primeiro teste
      Break;
    end;
  end;
  // se o CPF é composto por numeros repetido retorna falso
  if not Wvalid then
  begin
    Result := False;
    Exit;
  end;
  //executa o calculo para o primeiro verificador
  for i := 1 to 9 do
  begin
    Wdigit1 := Wdigit1 + (StrToInt(CPF[10-i])*(I+1));
  end;
  {formula do primeiro verificador
  soma=1°*2+2°*3+3°*4.. até 9°*10
  digito1 = 11 - soma mod 11
  se digito > 10 digito1 =0}
  Wdigit1:= ((11 - (Wdigit1 mod 11))mod 11) mod 10;
  //verifica se o 1° digito confere
  if IntToStr(Wdigit1) <> CPF[10] then
  begin
    Result := false;
    Exit;
  end;
  for i:=1 to 10 do
  begin
    Wdigit2 := Wdigit2 + (StrToInt(CPF[11-i])*(I+1));
  end;
  {formula do segundo verificador
  soma=1°*2+2°*3+3°*4.. até 10°*11
  digito1 = 11 - soma mod 11
  se digito > 10 digito1 =0}
  Wdigit2 := ((11 - (Wdigit2 mod 11))mod 11) mod 10;
  // confere o 2° digito verificador
  if IntToStr(Wdigit2) <> CPF[11] then
  begin
    Result := False;
    Exit;
  end;
  //se chegar até aqui o CPF é valido
  Result := True;end;
// Usando:
procedure TForm1.Button1Click(Sender: TObject);
begin
  if ValidacaoCPF(Edit1.Text) then
    ShowMessage('Válido')
  else
    ShowMessage('Invalido');
end;

Max Gehringer