String Encode-Decode

DrogbA

Forum Üyesi
Katılım
27 Ara 2020
Mesajlar
3,440
Tepkime puanı
0
Puanları
36
Kod:
const
  Codes64 = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz+/';
 
 
function Encode64(S: string): string;
var
  i: Integer;
  a: Integer;
  x: Integer;
  b: Integer;
begin
  Result := '';
  a := 0;
  b := 0;
  for i := 1 to Length(s) do
  begin
    x := Ord(s[i]);
    b := b * 256 + x;
    a := a + 8;
    while a >= 6 do
    begin
      a := a - 6;
      x := b div (1 shl a);
      b := b mod (1 shl a);
      Result := Result + Codes64[x + 1];
    end;
  end;
  if a > 0 then
  begin
    x := b shl (6 - a);
    Result := Result + Codes64[x + 1];
  end;
end;
 
 
function Decode64(S: string): string;
var
  i: Integer;
  a: Integer;
  x: Integer;
  b: Integer;
begin
  Result := '';
  a := 0;
  b := 0;
  for i := 1 to Length(s) do
  begin
    x := Pos(s[i], codes64) - 1;
    if x >= 0 then
    begin
      b := b * 64 + x;
      a := a + 6;
      if a >= 8 then
      begin
        a := a - 8;
        x := b shr a;
        b := b mod (1 shl a);
        x := x mod 256;
        Result := Result + chr(x);
      end;
    end
    else
      Exit;
  end;
end;
 
 
// Kullanımı
 
procedure TForm1.cxButton1Click(Sender: TObject);
var str : string;
begin
 str := Encode64('123456');
 showmessage(str); //  CJ8pD3Ks şeklinde encode ederek mesaj verir.
 str := Decode64('CJ8pD3Ks');
 showmessage(str); // 123456 şeklinde decode ederek mesaj verir.
end;
 

Admin

Owner
Kurucu Admin
Katılım
13 Mar 2019
Mesajlar
7,680
Tepkime puanı
35
Puanları
48
Yaş
36
Konum
istanbul
Web sitesi
www.isgir.com
Cinsiyet
  1. Bay
Takım
Tarafsız
Paylaşım için teşekkürler hocam.
 

Nutella

Bayan Üye
Özel Üye
Katılım
2 Ocak 2021
Mesajlar
3,559
Tepkime puanı
23
Puanları
36
Cinsiyet
  1. Bayan
Takım
Galatasaray
Paylaşım için teşekkürler.
 
metal işleme
Üst