Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
64-битное кодирование

Автор: Arne de Bruijn

В ходе судебного разбирательства с Microsoft были предложены четыре варианта решений:
1. Билл Гейтс должен застрелиться.
2. Билл Гейтс должен утопиться.
3. Билл Гейтс должен повеситься.
4. Билл Гейтс должен опубликовать исходные коды Windows.


{ 64-битное декодирование файлов }
{ Arne de Bruijn }
uses dos;
var

  Base64: array[43..122] of byte;
var

  T: text;
  Chars: set of char;
  S: string;
  K, I, J: word;
  Buf: pointer;
  DShift: integer;
  F: file;
  B, B1: byte;
  Decode: array[0..63] of byte;
  Shift2: byte;
  Size, W: word;
begin
  FillChar(Base64, SizeOf(Base64), 255);
  J := 0;
  for I := 65 to 90 do
  begin
    Base64[I] := J;
    Inc(J);
  end;
  for I := 97 to 122 do
  begin
    Base64[I] := J;
    Inc(J);
  end;
  for I := 48 to 57 do
  begin
    Base64[I] := J;
    Inc(J);
  end;
  Base64[43] := J;
  Inc(J);
  Base64[47] := J;
  Inc(J);
  if ParamCount = 0 then
  begin
    WriteLn('UNBASE64 <mime-файл> [<выходной файл>]');
    Halt(1);
  end;
  S := ParamStr(1);
  assign(T, S);
  GetMem(Buf, 32768);
  SetTextBuf(T, Buf^, 32768);
{$I-}reset(T);
{$I+}
  if IOResult <> 0 then
  begin
    WriteLn('Ошибка считывания ', S);
    Halt(1);
  end;
  if ParamCount >= 2 then
    S := ParamStr(2)
  else
  begin
    write('Расположение:');
    ReadLn(S);
  end;
  assign(F, S);
{$I-}rewrite(F, 1);
{$I+}
  if IOResult <> 0 then
  begin
    WriteLn('Ошибка создания ', S);
    Halt(1);
  end;
  while not eof(T) do
  begin
    ReadLn(T, S);
    if (S <> '') and (pos(' ', S) = 0) and (S[1] >= #43) and (S[1] <= #122) and
      (Base64[byte(S[1])] <> 255) then
    begin
      FillChar(Decode, SizeOf(Decode), 0);
      DShift := 0;
      J := 0;
      Shift2 := 1;
      Size := 255;
      B := 0;
      for I := 1 to Length(S) do
      begin
        case S[I] of
          #43..#122: B1 := Base64[Ord(S[I])];
        else
          B1 := 255;
        end;
        if B1 = 255 then
          if S[I] = '=' then
          begin
            B1 := 0;
            if Size = 255 then
              Size := J;
          end
          else
            WriteLn('Ошибка символа:', S[I], ' (', Ord(S[I]), ')');
        if DShift and 7 = 0 then
        begin
          Decode[J] := byte(B1 shl 2);
          DShift := 2;
        end
        else
        begin
          Decode[J] := Decode[J] or Hi(word(B1) shl (DShift + 2));
          Decode[J + 1] := Lo(word(B1) shl (DShift + 2));
          Inc(J);
          Inc(DShift, 2);
        end;
      end;
      if Size = 255 then
        Size := J;
      BlockWrite(F, Decode, Size);
    end;
  end;
  Close(F);
  close(T);
end.


Проект Delphi World © Выпуск 2002 - 2004
Автор проекта: ___Nikolay