delphi to xharbour

[jair]

Quiero convertir estas funciones en puerto con el enfoque principal en la función.
función TfrmGravaVendorMem.GetBuildInfo: cadena para generar el archivo txt a pesar de mostrarse como .mem pero en realidad es un archivo txt que se grabará.

Si tienes un colega que sepa programar en delphi y harbour que te de algunos consejos de como hacer esto.

xharbour + fivewin ou xharbour consola

Code: Select all  Expand view  RUN

    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.                                      

[Antonio Linares]

Dear Jair,

Please ask https://www.phind.com/ to do the code conversion. It works really well

You will have to try it several times