Converter delphi para harbour

Projeto [x]Harbour - Compilador de código aberto compatível com o Clipper.

Moderador: Moderadores

Responder
Avatar do usuário
jairfab
Usuário Nível 3
Usuário Nível 3
Mensagens: 252
Registrado em: 21 Mai 2007 09:43
Localização: São Paulo, Região Leste - Suzano

Converter delphi para harbour

Mensagem por jairfab »

Estou querendo converter estas funcoes para harbour com foco principal na funcao
function TfrmGravaVendorMem.GetBuildInfo: string para gerar o arquivo txt apesar de mostrar como .mem mas na realidade é um arquivo txt que vai ser gravado .

Se tiver algum colega que sabe programar em delphi e harbour para dar umas dicas de como fazer isto .

Código: Selecionar todos

unit uGravaVendorMem;

{$MODE Delphi}

interface

uses
  LCLIntf, LCLType, LMessages, Messages, SysUtils, Variants, Classes, Graphics,
  Controls, Forms, Dialogs, StdCtrls, Buttons, sBitBtn,
  StrUtils, Masks, sMaskEdit, sCustomComboEdit, sToolEdit;

type
  TfrmGravaVendorMem = class(TForm)
    edtArquivo: TEdit;
    OpenDialog1: TOpenDialog;
    mmArquivo: TMemo;
    btnAtualizar: TsBitBtn;
    btnArquivo: TsBitBtn;
    Label1: TLabel;
    edtData: TsDateEdit;
    mmCripto: TMemo;
    sBitBtn1: TsBitBtn;
    procedure btnArquivoClick(Sender: TObject);
    procedure btnAtualizarClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure sBitBtn1Click(Sender: TObject);
  private
    { Private declarations }
    c0MEM: String;
    Ch: Char;
    cDecrip, cValidade: String;
    lFiveWin: Boolean;

    function CriptogMem(cText : string) : string;
    function DecriptogMem(cText : string) : string;
    function DecriptogFiles(cText: String): String;
    function Decriptog(cText : string) : string;
    function StrRepl( cText : string; nLen : integer) : string;
    function GetBuildInfo:string;
    function CriptogFiles(cText: String): String;
    function Criptog(cText : string) : string;
  public
    { Public declarations }
  end;

var
  frmGravaVendorMem: TfrmGravaVendorMem;

implementation

{$R *.lfm}

{ TForm1 }

procedure TfrmGravaVendorMem.btnArquivoClick(Sender: TObject);
var i: Integer;
    F1: TextFile;
    dDataT: TDateTime;
begin
  OpenDialog1.InitialDir := ExtractFilePath(ParamStr(0));

  mmArquivo.Lines.Clear;

  lFiveWin := False;
  cDecrip := '';
  c0MEM := '';

  if OpenDialog1.Execute then
  begin
    edtArquivo.Text := OpenDialog1.FileName;

    mmArquivo.Lines.LoadFromFile(edtArquivo.Text);

    if Pos('VENDOR0.MEM', UpperCase(edtArquivo.Text)) > 0 then
    begin
      for i := 0 to mmArquivo.Lines.Count-1 do
      begin
        mmArquivo.Lines[i] := DecriptogMem(mmArquivo.Lines[i])
      end;

      try
        cValidade := mmArquivo.Lines[0];
        edtData.Text := cValidade;
        dDataT  := StrToDate(mmArquivo.Lines[0]);
      except
        lFiveWin := True;
        AssignFile(F1, OpenDialog1.FileName);
        Reset(F1);
        c0MEM := '';

        while not Eof(F1) do
        begin
          Read(F1, Ch);
          c0MEM := c0MEM + Ch;
        end;

        CloseFile(F1);

        cDecrip   := Copy(c0MEM,1,18);
        cValidade := Copy(cDecrip,8,2) + '/' + Copy(cDecrip,5,2) + '/' + Copy(cDecrip,11,2);
      end;
    end
    else if Pos('DBASK0.MEM', UpperCase(edtArquivo.Text)) > 0 then
    begin
      for i := 0 to mmArquivo.Lines.Count-1 do
      begin
        mmArquivo.Lines[i] := DecriptogMem(mmArquivo.Lines[i])
      end;

      cValidade := mmArquivo.Lines[0];
      edtData.Text := cValidade;
    end
    else
    begin
      AssignFile(F1, OpenDialog1.FileName);
      Reset(F1);
      c0MEM := '';

      while not Eof(F1) do
      begin
        Read(F1, Ch);
        c0MEM := c0MEM + Ch;
      end;

      CloseFile(F1);

      cDecrip := Copy(c0MEM,1,18);
      mmArquivo.Lines.Text := DecriptogFiles(c0MEM);

      cValidade := Copy(cDecrip,8,2) + '/' + Copy(cDecrip,5,2) + '/' + '20' + Copy(cDecrip,11,2);
      edtData.Text := cValidade;

      mmCripto.Lines.Clear;
      mmCripto.Lines.Text := Criptog(c0MEM);
    end;
//      mmArquivo.Lines.Text := Decriptog(mmArquivo.Lines.Text);
  end;

end;

procedure TfrmGravaVendorMem.btnAtualizarClick(Sender: TObject);
var F1: TextFile;
    I: Integer;
begin
  if Pos('VENDOR0.MEM', UpperCase(edtArquivo.Text)) > 0 then
  begin
    if Not lFiveWin then
    begin
      mmArquivo.Lines[0] := DateToStr(edtData.Date);

      for i := 0 to mmArquivo.Lines.Count-1 do
        mmArquivo.Lines[i] := CriptogMem(mmArquivo.Lines[i]);

      mmArquivo.Lines.SaveToFile(OpenDialog1.FileName);
    end
    else
    begin
      cValidade := FormatDateTime('yyyy-mm-dd', edtData.Date);

      c0MEM := Copy(cDecrip,1,4) + Copy(cValidade,6,2)+ '/' + Copy(cValidade,9,2) + '/' +
               Copy(cValidade,3,2) + Copy(cDecrip,13,6) + Copy(c0MEM,19,Length(c0MEM));

      AssignFile(F1, OpenDialog1.FileName);
      Rewrite(F1);
      Writeln(F1,c0MEM);
      CloseFile(F1);
    end;
  end
  else if Pos('DBASK0.MEM', UpperCase(edtArquivo.Text)) > 0 then
  begin
    mmArquivo.Lines[0] := DateToStr(edtData.Date);

    for i := 0 to mmArquivo.Lines.Count-1 do
      mmArquivo.Lines[i] := CriptogMem(mmArquivo.Lines[i]);

    mmArquivo.Lines.SaveToFile(OpenDialog1.FileName);
  end
  else
  begin
    cValidade := FormatDateTime('yyyy-mm-dd', edtData.Date);

    c0MEM := Copy(cDecrip,1,4) + Copy(cValidade,6,2)+ '/' + Copy(cValidade,9,2) + '/' +
             Copy(cValidade,3,2) + Copy(cDecrip,13,6) + Copy(c0MEM,19,Length(c0MEM));

    AssignFile(F1, OpenDialog1.FileName);
    Rewrite(F1);
    Writeln(F1,c0MEM);
    CloseFile(F1);
  end;

  mmArquivo.Lines.Clear;

  ShowMessage('Atualização efetuada com sucesso ! ');
end;

function TfrmGravaVendorMem.Criptog(cText: string): string;
var NWB, NWC, NWD, NWE, NWG : integer;
    NWF : char;
    NWH : boolean;
    NWI : string;
begin
  cText := StringReplace(cText,'0','Á',[rfReplaceAll]);
  cText := StringReplace(cText,'1','É',[rfReplaceAll]);
  cText := StringReplace(cText,'2','Í',[rfReplaceAll]);
  cText := StringReplace(cText,'3','Ó',[rfReplaceAll]);
  cText := StringReplace(cText,'4','Ú',[rfReplaceAll]);
  cText := StringReplace(cText,'5','À',[rfReplaceAll]);
  cText := StringReplace(cText,'6','È',[rfReplaceAll]);
  cText := StringReplace(cText,'7','Ì',[rfReplaceAll]);
  cText := StringReplace(cText,'8','Ò',[rfReplaceAll]);
  cText := StringReplace(cText,'9','Ù',[rfReplaceAll]);
  cText := cText + StrRepl(' ', 10 - length(cText));
  NWB := length(cText);
  NWC := trunc((NWB / 2) + 0.5);
  NWD := NWB - NWC;
  NWI := cText;
  NWH := True;
  for NWE := 1 to NWC do begin
    NWF := cText[ NWE ];
    if ((NWE-3) <= 0) then NWG := NWE+2 else NWG := NWE-3;
    delete(NWI,NWG,1);
    insert(NWF,NWI,NWG);
  end;
  for NWE := NWC+1 to NWB do begin
     NWF := cText[ NWE ];
     if((NWE+3) >= (NWB+1)) then NWG := NWE-2 else NWG := NWE+3;
     delete(NWI,NWG,1);
     insert(NWF,NWI,NWG);
  end;
  NWI := RightStr(NWI,NWD)+LeftStr(NWI,NWC);
  for NWE := 1 to NWB do begin
     NWF := NWI[ NWE ];
     if NWH then NWF := chr(ord(NWF)-31) else NWF := chr(ord(NWF)+31);
     delete(NWI,NWE,1);
     insert(NWF,NWI,NWE);
     NWH := ( not NWH );
  end;
  Criptog := NWI;
end;

function TfrmGravaVendorMem.CriptogFiles(cText: String): String;
var KX : array[1..50] of string;
    KK : array[1..50] of integer;
    KW, c0MEMDecript, cTemp,NWG, NWH,NWI, NWG2: String;
    KI, KM, I, J, NWA, NWJ, n : integer;
    liTemp : longint;
begin
  // ler da posição 1 até 16
  cText := 'N 5012/31/210114!.' + cText;
  KW := Copy(cText,1,16);

  // D A T A   D A    V A L I D A D E

  KI  := StrToInt(Copy(KW,13,2));             // atribui na variavel código da empresa
  if(KI = 0 ) then KI  := 1;
//  KM  := StrToInt(StrRight(KW,2));
  KM  := StrToInt(RightStr(KW,2));

  // leitura a partir da posição 17, copiando 78 caracteres
  n := 17;
  for I := 1 to KM do
  begin
    KX[I] := Copy(cText,n,78);
    n := n + 78;
  end;

  // Descriptografia do SPAG0.mem
  for I := 1 to 50 do
  begin
    KK[i] := 0;  // inicializar todas as posições do array com 0
  end;

  for NWA := 1 to KM do
  begin
    for J := 1 to 15  do
    begin  // de cinco em cinco, ex: 1,5,10,15
      i := j * 5;
      cTemp  := KX[NWA];
      liTemp := (Ord(cTemp[I+0]) * Ord(cTemp[I+1])) - (Ord(cTemp[I+2]) * Ord(cTemp[I+3])) + Ord(cTemp[I+4]);
      KK[NWA] := KK[NWA]+liTemp;
    end;
//    KK[NWA] := StrToInt(StrRight(IntToStr(KK[NWA]),2));
    KK[NWA] := StrToInt(RightStr(IntToStr(KK[NWA]),2));
    NWG := '';
    FOR I := 1 TO 76 do
    begin
      cTemp := KX[NWA];
      NWG := NWG + CHR(Ord(cTemp[I])-32);
    end;
    FOR J := 1 TO 3 do
    begin
      NWH := '';
      NWI := '';
      NWJ  := 1;
      FOR I := 1 TO 76 do
      begin
        IF NWJ  = 1 then
        begin
          NWH := NWH + Copy(NWG,I,1);
          NWJ  := 2;
        end
        ELSE
        begin
          NWI := NWI + Copy(NWG,I,1);
	        NWJ  := 1;
        END;
	    end;
      NWG := NWH + NWI;
    end;
    KX[NWA]  := NWG + Copy(KX[NWA],77,2);
    NWG2 := NWG2 + NWG;
  end;

  c0MEMDecript := '';
  for i:= 1 to length(KX) do
  begin
    c0MEMDecript := c0MEMDecript + KX[i];
  end;

  CriptogFiles := NWG2;
end;

function TfrmGravaVendorMem.CriptogMem(cText: string): string;
var i    : integer;
    lOkC : boolean;
    cRet : string;
    cCh  : Char;
begin
  cRet := ''; lOkC := True;
  for i := 1 to length(cText) do
  begin
     cCh := cText[ i ];
     if lOkC then cRet := cRet + chr(ord(cCh)-31) else cRet := cRet + chr(ord(cCh)+31);
     lOkC := ( not lOkC );
  end;
  CriptogMem := cRet;
end;

function TfrmGravaVendorMem.DecriptogMem(cText: string): string;
var i : integer;
    lOkC : boolean;
    cRet: string;
    cCh : char;
begin
  cRet := ''; lOkC := True;
  for i := 1 to length(cText) do
  begin
     cCh := cText[ i ];
     if lOkC then cRet := cRet + chr(ord(cCh)+31) else cRet := cRet + chr(ord(cCh)-31);
     lOkC := ( not lOkC );
  end;
  DeCriptogMem := cRet;
end;

function TfrmGravaVendorMem.StrRepl(cText: string; nLen: integer): string;
var cRet : string;
    i    : integer;
begin
   cRet := '';
   for i := 1 to nLen do cRet := cRet + cText;
   StrRepl := cRet;
end;

function TfrmGravaVendorMem.Decriptog(cText: string): string;
var NWB, NWC, NWD, NWE, NWG : integer;
    NWH : boolean;
    NWI : string;
    NWF : char;
begin
  cText := cText + StrRepl(' ', 10 - length(cText));
  NWB := length(cText);
  NWD := trunc((NWB / 2) + 0.5);
  NWC := NWB - trunc(NWD);
  NWI := cText;
  NWH := true;
  for NWE := 1 to NWB do begin
     NWF := cText[ NWE ];
     if NWH then NWF := chr((ord(NWF))+31) else NWF := chr(ord(NWF)-31);
     delete(NWI,NWE,1);
     insert(NWF,NWI,NWE);
     NWH := (not NWH)
  end;
  for NWE := 1 to NWC do begin
     NWF := NWI[ NWE ];
     if ((NWE-3) <=0) then NWG := NWE+2 else NWG := NWE-3;
     delete(cText,NWG,1);
     insert(NWF,cText,NWG);
  end;
  for NWE := NWC+1 to NWB do begin
     NWF := NWI[ NWE ];
     if ((NWE+3) >= (NWB+1)) then  NWG := NWE-2 else NWG := NWE+3;
     delete(cText,NWG,1);
     insert(NWF,cText,NWG);
  end;
  cText := RightStr(cText,NWD) + LeftStr(cText,NWC);
  cText := StringReplace(cText,'Á','0',[rfReplaceAll]);
  cText := StringReplace(cText,'É','1',[rfReplaceAll]);
  cText := StringReplace(cText,'Í','2',[rfReplaceAll]);
  cText := StringReplace(cText,'Ó','3',[rfReplaceAll]);
  cText := StringReplace(cText,'Ú','4',[rfReplaceAll]);
  cText := StringReplace(cText,'À','5',[rfReplaceAll]);
  cText := StringReplace(cText,'È','6',[rfReplaceAll]);
  cText := StringReplace(cText,'Ì','7',[rfReplaceAll]);
  cText := StringReplace(cText,'Ò','8',[rfReplaceAll]);
  cText := StringReplace(cText,'Ù','9',[rfReplaceAll]);
  Decriptog := cText;
end;

function TfrmGravaVendorMem.DecriptogFiles(cText: String): String;
var KX : array[1..50] of string;
    KK : array[1..50] of integer;
    KW, c0MEMDecript, cTemp,NWG, NWH,NWI, NWG2: String;
    KI, KM, I, J, NWA, NWJ, n : integer;
    liTemp : longint;
begin
  // ler da posição 1 até 16
  KW := Copy(cText,1,16);

  // D A T A   D A    V A L I D A D E

  KI  := StrToInt(Copy(KW,13,2));             // atribui na variavel código da empresa
  if(KI = 0 ) then KI  := 1;
//  KM  := StrToInt(StrRight(KW,2));
  KM  := StrToInt(RightStr(KW,2));

  // leitura a partir da posição 17, copiando 78 caracteres
  n := 17;
  for I := 1 to KM do
  begin
    KX[I] := Copy(cText,n,78);
    n := n + 78;
  end;

  // Descriptografia do SPAG0.mem
  for I := 1 to 50 do
  begin
    KK[i] := 0;  // inicializar todas as posições do array com 0
  end;

  for NWA := 1 to KM do
  begin
    for J := 1 to 15  do
    begin  // de cinco em cinco, ex: 1,5,10,15
      i := j * 5;
      cTemp  := KX[NWA];
      liTemp := (Ord(cTemp[I+0]) * Ord(cTemp[I+1]))-(Ord(cTemp[I+2])*Ord(cTemp[I+3]))+Ord(cTemp[I+4]);
      KK[NWA] := KK[NWA]+liTemp;
    end;
//    KK[NWA] := StrToInt(StrRight(IntToStr(KK[NWA]),2));
    KK[NWA] := StrToInt(RightStr(IntToStr(KK[NWA]),2));
    NWG := '';
    FOR I := 1 TO 76 do
    begin
      cTemp := KX[NWA];
      NWG := NWG + CHR(Ord(cTemp[I])+32);
    end;
    FOR J := 1 TO 3 do
    begin
      NWH := '';
      NWI := '';
      NWJ  := 1;
      FOR I := 1 TO 76 do
      begin
        IF NWJ  = 1 then
        begin
          NWH := NWH + Copy(NWG,I,1);
          NWJ  := 2;
        end
        ELSE
        begin
          NWI := NWI + Copy(NWG,I,1);
	        NWJ  := 1;
        END;
	    end;
      NWG := NWH + NWI;
    end;
    KX[NWA]  := NWG + Copy(KX[NWA],77,2);
    NWG2 := NWG2 + NWG;
  end;

  c0MEMDecript := '';
  for i:= 1 to length(KX) do
  begin
    c0MEMDecript := c0MEMDecript + KX[i];
  end;

  DecriptogFiles := NWG2;
end;

function TfrmGravaVendorMem.GetBuildInfo: string;
var VerInfoSize: DWORD;
    VerInfo: Pointer;
    VerValueSize: DWORD;
    VerValue: PVSFixedFileInfo;
    Dummy: DWORD;
    V1, V2, V3, V4: Word;
    Prog : string;
begin
  Prog := Application.Exename;
  VerInfoSize := GetFileVersionInfoSize(pChar(prog), Dummy);
  GetMem(VerInfo, VerInfoSize);
  GetFileVersionInfo(pChar (prog), 0, VerInfoSize, VerInfo);
  VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize);
  with VerValue^ do
  begin
    V1 := dwFileVersionMS shr 16;
    V2 := dwFileVersionMS and $FFFF;
    V3 := dwFileVersionLS shr 16;
    V4 := dwFileVersionLS and $FFFF;
  end;
  FreeMem(VerInfo, VerInfoSize);
//  result := Copy (IntToStr (100 + v1), 3, 2) + '.' +
//            Copy (IntToStr (100 + v2), 3, 2) + '.' +
//            Copy (IntToStr (100 + v3), 3, 2) + '.' +
//            Copy (IntToStr (100 + v4), 3, 2);
  Result := Format('%d.%d.%d.%d', [v1, v2, v3, v4]);
end;

procedure TfrmGravaVendorMem.sBitBtn1Click(Sender: TObject);
begin
  mmCripto.Lines.SaveToFile(edtArquivo.Text + '_Crp');
end;

procedure TfrmGravaVendorMem.FormShow(Sender: TObject);
begin
  Caption := Caption + ' - Versão: ' + GetBuildInfo;
end;

end.
Delpji 7, harbour 3.2, xharbour 1.2.3, Bcc7, Minigw, Minigui 19.11, hwgui 2.20, FiveWin 19.05 Gtwvw, Gtwvg, C# VS 2017
Voltar ao topo
Avatar do usuário
mauricioportela
Usuário Nível 2
Usuário Nível 2
Mensagens: 95
Registrado em: 29 Jul 2016 04:22
Localização: Vitoria da Conquista/Bahia

Converter delphi para harbour

Mensagem por mauricioportela »

Veja se voce consegue seguir daqui:

Código: Selecionar todos

procedure TfrmGravaVendorMem.btnArquivoClick()
    local i := 0, F1, dDataT
    OpenDialog1.InitialDir := ExtractFilePath(ParamStr(0))
    mmArquivo.Lines.Clear
    lFiveWin := False
    cDecrip := ''
    c0MEM := ''
    if OpenDialog1.Execute
        edtArquivo.Text := OpenDialog1.FileName
        mmArquivo.Lines.LoadFromFile(edtArquivo.Text)
        if Pos('VENDOR0.MEM', UpperCase(edtArquivo.Text)) > 0
            for i := 0 to mmArquivo.Lines.Count-1
                mmArquivo.Lines[i] := DecriptogMem(mmArquivo.Lines[i])
            next
            try
                cValidade := mmArquivo.Lines[0]
                edtData.Text := cValidade
                dDataT  := StrToDate(mmArquivo.Lines[0])
            except
                lFiveWin := True
            end
            AssignFile(F1, OpenDialog1.FileName)
            Reset(F1)
            c0MEM := ''
            while not Eof(F1)
                Read(F1, Ch)
                c0MEM := c0MEM + Ch
            enddo
            CloseFile(F1)
            cDecrip   := Copy(c0MEM,1,18)
            cValidade := Copy(cDecrip,8,2) + '/' + Copy(cDecrip,5,2) + '/' + Copy(cDecrip,11,2)
        endif
    elseif Pos('DBASK0.MEM', UpperCase(edtArquivo.Text)) > 0
        for i := 0 to mmArquivo.Lines.Count-1
            mmArquivo.Lines[i] := DecriptogMem(mmArquivo.Lines[i])
        next
        cValidade := mmArquivo.Lines[0]
        edtData.Text := cValidade
    else
        AssignFile(F1, OpenDialog1.FileName)
        Reset(F1)
        c0MEM := ''
        while not Eof(F1)
            Read(F1, Ch)
            c0MEM := c0MEM + Ch
        enddo
        CloseFile(F1)
        cDecrip := Copy(c0MEM,1,18)
        mmArquivo.Lines.Text := DecriptogFiles(c0MEM)
        cValidade := Copy(cDecrip,8,2) + '/' + Copy(cDecrip,5,2) + '/' + '20' + Copy(cDecrip,11,2)
        edtData.Text := cValidade
        mmCripto.Lines.Clear
        mmCripto.Lines.Text := Criptog(c0MEM)
    endif
return Nil

procedure TfrmGravaVendorMem.btnAtualizarClick()
    local F1, I
    if Pos('VENDOR0.MEM', UpperCase(edtArquivo.Text)) > 0
        if Not lFiveWin
            mmArquivo.Lines[0] := DateToStr(edtData.Date)
            for i := 0 to mmArquivo.Lines.Count-1
                mmArquivo.Lines[i] := CriptogMem(mmArquivo.Lines[i])
            next
            mmArquivo.Lines.SaveToFile(OpenDialog1.FileName)
        else
            cValidade := FormatDateTime('yyyy-mm-dd', edtData.Date)
            c0MEM := Copy(cDecrip,1,4) + Copy(cValidade,6,2)+ '/' + Copy(cValidade,9,2) + '/' + ;
                     Copy(cValidade,3,2) + Copy(cDecrip,13,6) + Copy(c0MEM,19,Length(c0MEM));
            AssignFile(F1, OpenDialog1.FileName)
            Rewrite(F1)
            Writeln(F1,c0MEM)
            CloseFile(F1)
        endif
    elseif Pos('DBASK0.MEM', UpperCase(edtArquivo.Text)) > 0
        mmArquivo.Lines[0] := DateToStr(edtData.Date)
        for i := 0 to mmArquivo.Lines.Count-1
            mmArquivo.Lines[i] := CriptogMem(mmArquivo.Lines[i])
        next
        mmArquivo.Lines.SaveToFile(OpenDialog1.FileName)
    else
        cValidade := FormatDateTime('yyyy-mm-dd', edtData.Date)
        c0MEM := Copy(cDecrip,1,4) + Copy(cValidade,6,2)+ '/' + Copy(cValidade,9,2) + '/' + ;
                 Copy(cValidade,3,2) + Copy(cDecrip,13,6) + Copy(c0MEM,19,Length(c0MEM))
        AssignFile(F1, OpenDialog1.FileName)
        Rewrite(F1)
        Writeln(F1,c0MEM)
        CloseFile(F1)
    endif
    mmArquivo.Lines.Clear
    ShowMessage('Atualização efetuada com sucesso ! ')
end;

function TfrmGravaVendorMem.Criptog(cText)
    local NWB, NWC, NWD, NWE, NWG
    local NWF
    local NWH
    local NWI
    cText := StringReplace(cText,'0','Á',[rfReplaceAll])
    cText := StringReplace(cText,'1','É',[rfReplaceAll])
    cText := StringReplace(cText,'2','Í',[rfReplaceAll])
    cText := StringReplace(cText,'3','Ó',[rfReplaceAll])
    cText := StringReplace(cText,'4','Ú',[rfReplaceAll])
    cText := StringReplace(cText,'5','À',[rfReplaceAll])
    cText := StringReplace(cText,'6','È',[rfReplaceAll])
    cText := StringReplace(cText,'7','Ì',[rfReplaceAll])
    cText := StringReplace(cText,'8','Ò',[rfReplaceAll])
    cText := StringReplace(cText,'9','Ù',[rfReplaceAll])
    cText := cText + StrRepl(' ', 10 - length(cText))
    NWB := length(cText)
    NWC := trunc((NWB / 2) + 0.5)
    NWD := NWB - NWC
    NWI := cText
    NWH := True
    for NWE := 1 to NWC
        NWF := cText[NWE]
        if ((NWE-3) <= 0)
            NWG := NWE+2
        else
            NWG := NWE-3
        endif
        delete(NWI,NWG,1)
        insert(NWF,NWI,NWG)
    next
    for NWE := NWC+1 to NWB
        NWF := cText[ NWE ]
        if((NWE+3) >= (NWB+1))
            NWG := NWE-2
        else
            NWG := NWE+3
        endif
        delete(NWI,NWG,1)
        insert(NWF,NWI,NWG)
    next
    NWI := RightStr(NWI,NWD)+LeftStr(NWI,NWC)
    for NWE := 1 to NWB
        NWF := NWI[ NWE ]
        if NWH
            NWF := chr(ord(NWF)-31)
        else
            NWF := chr(ord(NWF)+31)
        endif
        delete(NWI,NWE,1)
        insert(NWF,NWI,NWE)
        NWH := ( not NWH )
    next
    Criptog := NWI
return

function TfrmGravaVendorMem.CriptogFiles(cText)
    local KX : array[1..50] of string
    local KK : array[1..50] of integer
    local KW, c0MEMDecript, cTemp,NWG, NWH,NWI, NWG2
    local KI, KM, I, J, NWA, NWJ, n
    local liTemp
    cText := 'N 5012/31/210114!.' + cText
    KW := Copy(cText,1,16)
    KI  := StrToInt(Copy(KW,13,2))
    if(KI == 0)
        KI  := 1
    endif
    KM  := StrToInt(RightStr(KW,2))
    n := 17
    for I := 1 to KM
        KX[I] := Copy(cText,n,78)
        n := n + 78
    next
    for I := 1 to 50
        KK[i] := 0
    next
    for NWA := 1 to KM
        for J := 1 to 15
            i := j * 5
            cTemp  := KX[NWA]
            liTemp := (Ord(cTemp[I+0]) * Ord(cTemp[I+1])) - (Ord(cTemp[I+2]) * Ord(cTemp[I+3])) + Ord(cTemp[I+4])
            KK[NWA] := KK[NWA]+liTemp
        next
        KK[NWA] := StrToInt(RightStr(IntToStr(KK[NWA]),2))
        NWG := ''
        FOR I := 1 TO 76
            cTemp := KX[NWA]
            NWG := NWG + CHR(Ord(cTemp[I])-32)
        next
        FOR J := 1 TO 3
            NWH := '';
            NWI := '';
            NWJ  := 1;
            FOR I := 1 TO 76
                IF NWJ  = 1
                    NWH := NWH + Copy(NWG,I,1)
                    NWJ  := 2
                ELSE
                    NWI := NWI + Copy(NWG,I,1)
                    NWJ  := 1
                ENDIF
            next
        next
        NWG := NWH + NWI
    next
    KX[NWA]  := NWG + Copy(KX[NWA],77,2)
    NWG2 := NWG2 + NWG
    c0MEMDecript := ''
    for i:= 1 to length(KX)
        c0MEMDecript := c0MEMDecript + KX[i]
    next
    CriptogFiles := NWG2
return

function TfrmGravaVendorMem.CriptogMem(cText)
    local i, lOkC, cRet, cCh
    cRet := ''
    lOkC := True
    for i := 1 to length(cText)
        while
            cCh := cText[ i ]
            if lOkC
                cRet := cRet + chr(ord(cCh)-31)
            else
                cRet := cRet + chr(ord(cCh)+31)
            endif
            lOkC := ( not lOkC )
        enddo
    next
    CriptogMem := cRet
return

function TfrmGravaVendorMem.DecriptogMem(cText)
    local i, lOkC, cRet, cCh
    cRet := ''
    lOkC := True
    for i := 1 to length(cText)
        cCh := cText[ i ]
        if lOkC
            cRet := cRet + chr(ord(cCh)+31)
        else
            cRet := cRet + chr(ord(cCh)-31)
        endif
        lOkC := ( not lOkC )
    next
    DeCriptogMem := cRet
return

function TfrmGravaVendorMem.StrRepl(cText, nLen)
    local cRet, i
    cRet := ''
    for i := 1 to nLen 
        cRet := cRet + cText
    next
    StrRepl := cRet
return

function TfrmGravaVendorMem.Decriptog(cText)
    local NWB, NWC, NWD, NWE, NWG
    local NWH
    local NWI
    local NWF
    cText := cText + StrRepl(' ', 10 - length(cText))
    NWB := length(cText)
    NWD := trunc((NWB / 2) + 0.5)
    NWC := NWB - trunc(NWD)
    NWI := cText
    NWH := true
    for NWE := 1 to NWB
        NWF := cText[ NWE ]
        if NWH
            NWF := chr((ord(NWF))+31)
        else
            NWF := chr(ord(NWF)-31)
        endif
        delete(NWI,NWE,1)
        insert(NWF,NWI,NWE)
        NWH := (not NWH)
    next
    for NWE := 1 to NWC
        NWF := NWI[ NWE ]
        if ((NWE-3) <=0)
            NWG := NWE+2
        else
            NWG := NWE-3
        endif
        delete(cText,NWG,1)
        insert(NWF,cText,NWG)
    next
    for NWE := NWC+1 to NWB
        NWF := NWI[ NWE ]
        if ((NWE+3) >= (NWB+1))
            NWG := NWE-2
        else
            NWG := NWE+3
        endif
        delete(cText,NWG,1)
        insert(NWF,cText,NWG)
    next
    cText := RightStr(cText,NWD) + LeftStr(cText,NWC)
    cText := StringReplace(cText,'Á','0',[rfReplaceAll])
    cText := StringReplace(cText,'É','1',[rfReplaceAll])
    cText := StringReplace(cText,'Í','2',[rfReplaceAll])
    cText := StringReplace(cText,'Ó','3',[rfReplaceAll])
    cText := StringReplace(cText,'Ú','4',[rfReplaceAll])
    cText := StringReplace(cText,'À','5',[rfReplaceAll])
    cText := StringReplace(cText,'È','6',[rfReplaceAll])
    cText := StringReplace(cText,'Ì','7',[rfReplaceAll])
    cText := StringReplace(cText,'Ò','8',[rfReplaceAll])
    cText := StringReplace(cText,'Ù','9',[rfReplaceAll])
    Decriptog := cText
return

function TfrmGravaVendorMem.DecriptogFiles(cText)
    local KX : array[1..50] of string
    local KK : array[1..50] of integer
    local KW, c0MEMDecript, cTemp,NWG, NWH,NWI, NWG2
    local KI, KM, I, J, NWA, NWJ, n
    local liTemp : longint
    KW := Copy(cText,1,16)
    KI  := StrToInt(Copy(KW,13,2))
    if(KI = 0 )
        KI  := 1
    endif
    KM  := StrToInt(RightStr(KW,2))
    n := 17
    for I := 1 to KM
        KX[I] := Copy(cText,n,78)
        n := n + 78
    next
    for I := 1 to 50
        KK[i] := 0
    next
    for NWA := 1 to KM
        for J := 1 to 15
            i := j * 5
            cTemp  := KX[NWA]
            liTemp := (Ord(cTemp[I+0]) * Ord(cTemp[I+1]))-(Ord(cTemp[I+2])*Ord(cTemp[I+3]))+Ord(cTemp[I+4])
            KK[NWA] := KK[NWA]+liTemp
        next
        KK[NWA] := StrToInt(RightStr(IntToStr(KK[NWA]),2))
        NWG := ''
        FOR I := 1 TO 76
            cTemp := KX[NWA]
            NWG := NWG + CHR(Ord(cTemp[I])+32)
        next
        FOR J := 1 TO 3
            NWH := ''
            NWI := ''
            NWJ  := 1
            FOR I := 1 TO 76
                IF NWJ == 1
                    NWH := NWH + Copy(NWG,I,1)
                    NWJ  := 2
                ELSE
                    NWI := NWI + Copy(NWG,I,1)
                    NWJ  := 1
                ENIF
            next
            NWG := NWH + NWI
        next
        KX[NWA]  := NWG + Copy(KX[NWA],77,2)
        NWG2 := NWG2 + NWG
    next
    c0MEMDecript := ''
    for i:= 1 to length(KX)
        c0MEMDecript := c0MEMDecript + KX[i]
    next
    DecriptogFiles := NWG2
end;


function TfrmGravaVendorMem.DecriptogFiles(cText)
    local KX : array[1..50] of string
    local KK : array[1..50] of integer

    local KW, c0MEMDecript, cTemp,NWG, NWH,NWI, NWG2
    local KI, KM, I, J, NWA, NWJ, n
    local liTemp
    KW := Copy(cText,1,16)
    KI  := StrToInt(Copy(KW,13,2))
    if(KI = 0 )
        KI  := 1
    endif
    KM  := StrToInt(RightStr(KW,2))
    n := 17
    for I := 1 to KM
        KX[I] := Copy(cText,n,78)
        n := n + 78
    next
    for I := 1 to 50
        KK[i] := 0
    next
    for NWA := 1 to KM
        for J := 1 to 15
            i := j * 5
            cTemp  := KX[NWA]
            liTemp := (Ord(cTemp[I+0]) * Ord(cTemp[I+1]))-(Ord(cTemp[I+2])*Ord(cTemp[I+3]))+Ord(cTemp[I+4])
            KK[NWA] := KK[NWA]+liTemp
        next
        KK[NWA] := StrToInt(RightStr(IntToStr(KK[NWA]),2))
        NWG := ''
        FOR I := 1 TO 76 do
            cTemp := KX[NWA]
            NWG := NWG + CHR(Ord(cTemp[I])+32)
        next
        FOR J := 1 TO 3 do
            NWH := ''
            NWI := ''
            NWJ  := 1
            FOR I := 1 TO 76
                IF NWJ  = 1
                    NWH := NWH + Copy(NWG,I,1)
                    NWJ  := 2
                ELSE
                    NWI := NWI + Copy(NWG,I,1)
                    NWJ  := 1
                ENDIF
            next
            NWG := NWH + NWI
        next
        KX[NWA]  := NWG + Copy(KX[NWA],77,2)
        NWG2 := NWG2 + NWG
    next
    c0MEMDecript := ''
    for i:= 1 to length(KX)
        c0MEMDecript := c0MEMDecript + KX[i]
    next
    DecriptogFiles := NWG2
return

function TfrmGravaVendorMem.GetBuildInfo()
    local VerInfoSize
    local VerInfo
    local VerValueSize
    local VerValue
    local Dummy
    local V1, V2, V3, V4
    local Prog
    Prog := Application.Exename
    VerInfoSize := GetFileVersionInfoSize(pChar(prog), Dummy)
    GetMem(VerInfo, VerInfoSize)
    GetFileVersionInfo(pChar (prog), 0, VerInfoSize, VerInfo)
    VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize)
    with VerValue^ do
        V1 := dwFileVersionMS shr 16
        V2 := dwFileVersionMS and $FFFF
        V3 := dwFileVersionLS shr 16
        V4 := dwFileVersionLS and $FFFF
    end;
    FreeMem(VerInfo, VerInfoSize)
    Result := Format('%d.%d.%d.%d', [v1, v2, v3, v4])
end;

procedure TfrmGravaVendorMem.sBitBtn1Click()
    mmCripto.Lines.SaveToFile(edtArquivo.Text + '_Crp')
return

procedure TfrmGravaVendorMem.FormShow()
    Caption := Caption + ' - Versão: ' + GetBuildInfo
return
Att.

Mauricio Portela
Voltar ao topo
Avatar do usuário
jairfab
Usuário Nível 3
Usuário Nível 3
Mensagens: 252
Registrado em: 21 Mai 2007 09:43
Localização: São Paulo, Região Leste - Suzano

Converter delphi para harbour

Mensagem por jairfab »

Acredito que apartir daqui da para mim finalizar.
Delpji 7, harbour 3.2, xharbour 1.2.3, Bcc7, Minigw, Minigui 19.11, hwgui 2.20, FiveWin 19.05 Gtwvw, Gtwvg, C# VS 2017
Voltar ao topo
Responder

Voltar para “[x]Harbour”