Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Сети";
Текущий архив: 2004.06.13;
Скачать: [xml.tar.bz2];

Вниз

Base64 кодирование файлов   Найти похожие ветки 

 
FatBase   (2004-04-22 06:50) [0]

Может кто нибудь подбросит фу-ю Base64 кодирования файлов, стандартный компонент Delphi использовать неохота. Заранее благодарен.


 
xShadow ©   (2004-04-22 10:01) [1]

//BASE64------------------------------------------------------------------------
Function TArcMan.EncodeBase64( Data: PChar; Len: Integer ): String;
const B64 : array [0..63] of Char = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" +
                                   "abcdefghijklmnopqrstuvwxyz" +
                                   "0123456789+/";
var Ic    : Integer;
   Pi, Po: TPAByte;
   C1    : DWord;
Begin
   if Len > 0 then
   Begin
      SetLength( Result, ( ( Len + 2 ) div 3 ) * 4 );
      Pi := Pointer( Data );
      Po := Pointer( Result );
      for Ic := 1 to Len div 3 do
      Begin
         C1 := Pi^[0] shl 16 + Pi^[1] shl 8 + Pi^[2];
         Po^[0] := Byte( B64[( C1 shr 18 ) and $3f] );
         Po^[1] := Byte( B64[( C1 shr 12 ) and $3f] );
         Po^[2] := Byte( B64[( C1 shr  6 ) and $3f] );
         Po^[3] := Byte( b64[( c1        ) and $3f] );
         Inc( DWord( Po ), 4 );
         Inc( DWord( Pi ), 3 );
      end;
      Case Len mod 3 of
           1: Begin
                 C1 := Pi^[0] shl 16;
                 Po^[0] := Byte( B64[( C1 shr 18 ) and $3f] );
                 Po^[1] := Byte( B64[( C1 shr 12 ) and $3f] );
                 Po^[2] := Byte( "=" );
                 Po^[3] := Byte("=");
              end;
           2: Begin
                 C1 := Pi^[0] shl 16 + Pi^[1] shl 8;
                 Po^[0] := Byte( B64[( C1 shr 18 ) and $3f] );
                 Po^[1] := Byte( B64[( C1 shr 12 ) and $3f] );
                 Po^[2] := Byte( B64[( C1 shr  6 ) and $3f] );
                 Po^[3] := Byte("=");
              end;
      end;
   end else Result := "";
end;

Function TArcMan.EncodeBase64( Data: String ): String;
Begin
   Result := EncodeBase64( PChar( Data ), Length( Data ) );
end;

Function TArcMan.DecodeBase64( Data: PChar; Len: Integer ): String;
var I1, I2: Integer;
   Pi, Po: TPAByte;
   ch1   : Char;
   c1    : DWord;
Begin
   if ( Len > 0 ) and ( Len mod 4 = 0 ) then
   Begin
      Len := Len shr 2;
      SetLength( Result, Len * 3 );
      Pi := Pointer( Data );
      Po := Pointer( Result );
      for I1 := 1 to Len do
      Begin
         C1 := 0;
         I2 := 0;
         While True do
         Begin
            Ch1 := Char( Pi^[I2] );
            Case Ch1 of
                 "A".."Z": C1 := C1 or ( DWord( Ch1 ) - Byte( "A" )      );
                 "a".."z": C1 := C1 or ( DWord( Ch1 ) - Byte( "a" ) + 26 );
                 "0".."9": C1 := C1 or ( DWord( Ch1 ) - Byte( "0" ) + 52 );
                 "+"     : C1 := C1 or 62;
                 "/"     : C1 := C1 or 63;
            else
             Begin
                if I2 = 3 then
                Begin
                   Po^[0] := C1 shr 16;
                   Po^[1] := Byte( C1 shr 8 );
                   SetLength( Result, Length( Result ) - 1 );
                end else
                Begin
                    Po^[0] := C1 shr 10;
                    SetLength( Result, Length( Result ) - 2 );
                end;
                Exit;
             end;
            end;
            if I2 = 3 then break;
            Inc( I2 );
            C1 := C1 shl 6;
         end;
         Po^[0] := C1 shr 16;
         Po^[1] := Byte( C1 shr 8 );
         Po^[2] := Byte( C1 );
         Inc( DWord( Pi ), 4 );
         Inc( DWord( Po ), 3 );
      end;
   end else Result := "";
end;

Function TArcMan.DecodeBase64( Data: String ): String;
Begin
   Result := DecodeBase64( PChar( Data ), Length( Data ) );
end;
//END BASE----------------------------------------------------------------------


 
FatBase   (2004-04-23 05:30) [2]

xShadow, ограомное тебе спасибо!, выручил!


 
FatBase   (2004-04-24 12:07) [3]

xShadow, что это за тип данных TPAByte, дай плиз описание. Это насколько я понял для кодирование декодирования текста, а как закодировать файлы, кто нить подскажет?


 
Piter ©   (2004-04-24 13:04) [4]

function EncodeBase64(const inStr: string): string;

 function Encode_Byte(b: Byte): char;
 const
   Base64Code: string[64] =
     "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
 begin
   Result := Base64Code[(b and $3F)+1];
 end;

var
 i: Integer;
begin
 i := 1;
 Result := "";
 while i <=Length(InStr) do
 begin
   Result := Result + Encode_Byte(Byte(inStr[i]) shr 2);
   Result := Result + Encode_Byte((Byte(inStr[i]) shl 4) or (Byte(inStr[i+1]) shr 4));
   if i+1 <=Length(inStr) then
     Result := Result + Encode_Byte((Byte(inStr[i+1]) shl 2) or (Byte(inStr[i+2]) shr 6))
   else
     Result := Result + "=";
   if i+2 <=Length(inStr) then
     Result := Result + Encode_Byte(Byte(inStr[i+2]))
   else
     Result := Result + "=";
   Inc(i, 3);
 end;
end;


 
Piter ©   (2004-04-24 13:05) [5]

это для кодирования


 
SergP ©   (2004-04-24 13:30) [6]


> Это насколько я понял для кодирование декодирования текста,
> а как закодировать файлы, кто нить подскажет?


Ну так засунь файл в строку, закодируй, а потом закодированое высунь обратно в файл...


 
FatBase   (2004-04-25 05:48) [7]

Всем спасибо проблему решил



Страницы: 1 вся ветка

Форум: "Сети";
Текущий архив: 2004.06.13;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.47 MB
Время: 0.068 c
14-1085393487
lehich
2004-05-24 14:11
2004.06.13
запароленый excel


4-1083835490
webpauk
2004-05-06 13:24
2004.06.13
Данные из чужого окна


1-1086158108
hexone
2004-06-02 10:35
2004.06.13
Вхождение в пустой Set


3-1085032891
Alex_x
2004-05-20 10:01
2004.06.13
технология доступа в MIDAS?


1-1085742909
nitro
2004-05-28 15:15
2004.06.13
Перемещение строки из компонента Listbox1 в Listbox2.





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский