Binarni zapis fajla

Code:
function FileToBin(const ASourceFile, ATargetFile : String) : Integer;

  function IntToBin(AValue : LongInt; ADigits : Integer) : String;
  begin
    result := StringOfChar('0', ADigits);
    While AValue > 0 Do
    Begin
      If (AValue and 1) = 1 Then
        result[ADigits] := '1';
      Dec(ADigits);
      AValue := AValue shr 1;
    End;
  end;

type
  TCharArray = Array[0..High(Word) div SizeOf(Char) - 1] of Char;
  PCharArray = ^TCharArray;

const
  maxbufsize = 1024 * 1024 * 16; // 16mb
var
  fhndIn, fhndOut : HFILE;
  ofstr           : TOfStruct;
  buf, binbuf     : PCharArray;
  bread, bwrite   : DWORD;
  C1              : DWORD;
  binstr          : String;
  bufsize         : DWORD;
  filesize        : DWORD;
begin
  fhndIn := OpenFile(PAnsiChar(ASourceFile), ofstr, OF_READ);
  If fhndIn <> HFILE_ERROR Then
  Begin
    fhndOut := CreateFile(PAnsiChar(ATargetFile), GENERIC_READ or GENERIC_WRITE, 0, nil,
                          CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
    If fhndOut <> INVALID_HANDLE_VALUE Then
    Begin
      filesize := GetFileSize(fhndIn, nil);
      If filesize > maxbufsize Then
        bufsize := maxbufsize
      else
        bufsize := filesize;

      GetMem(buf, bufsize);
      GetMem(binbuf, bufsize * 8);
      repeat
        ReadFile(fhndIn, buf^, bufsize, bread, nil);
        If bread > 0 Then
          For C1 := 0 to bread - 1 Do
          Begin
            binstr := IntToBin(Ord(buf^[C1]), 8);
            Move(binstr[1], binbuf^[C1 * 8], 8);
          End;
        WriteFile(fhndOut, binbuf^, bread * 8, bwrite, nil);
      until bufsize <> bread;
      FreeMem(buf);
      FreeMem(binbuf);
      CloseHandle(fhndOut);
      result := ERROR_SUCCESS;
    End
    else
      result := GetLastError;

    CloseHandle(fhndIn);
  End
  else
    result := GetLastError;
end;

Code:
function BinToFile(const ASourceFile, ATargetFile : String) : Integer;

  function BinToInt(AValue : String) : LongInt;
  var
    C1  : Integer;
    len : Integer;
    cut : Integer;
  begin
    result := 0;

    len := Length(AValue);
    cut := 0;
    For C1 := 1 to Length(AValue) Do
      If AValue[C1] <> '0' Then
      Begin
        cut := C1 - 1;
        Break;
      End;
    If cut > 0 Then
    Begin
      Delete(AValue, 1, cut);
      Dec(len, cut);
    End;

    If AValue <> '' Then
      For C1 := len downto 1 Do
        If AValue[C1] = '1' Then
          result := result + (1 shl (len - C1));
  end;

type
  TCharArray = Array[0..High(Word) div SizeOf(Char) - 1] of Char;
  PCharArray = ^TCharArray;

const
  maxbufsize = 1024 * 1024 * 16; // 16mb
var
  fhndIn, fhndOut : HFILE;
  ofstr           : TOfStruct;
  buf, chrbuf     : PCharArray;
  bread, bwrite   : DWORD;
  bufsize         : DWORD;
  filesize        : DWORD;
  C1              : Integer;
begin
  fhndIn := OpenFile(PAnsiChar(ASourceFile), ofstr, OF_READ);
  If fhndIn <> HFILE_ERROR Then
  Begin
    fhndOut := CreateFile(PAnsiChar(ATargetFile), GENERIC_READ or GENERIC_WRITE, 0, nil,
                          CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
    If fhndOut <> INVALID_HANDLE_VALUE Then
    Begin
      filesize := GetFileSize(fhndIn, nil);
      If filesize > maxbufsize Then
        bufsize := maxbufsize
      else
        bufsize := filesize;

      GetMem(buf, bufsize);
      GetMem(chrbuf, bufsize div 8);
      repeat
        ReadFile(fhndIn, buf^, bufsize, bread, nil);
        If bread > 0 Then
          For C1 := 0 to (bread div 8) - 1 Do
            chrbuf^[C1] := Chr(BinToInt(Copy(buf^, C1 * 8 + 1, 8)));

        WriteFile(fhndOut, chrbuf^, bread div 8, bwrite, nil);
      until bufsize <> bread;
      FreeMem(buf);
      FreeMem(chrbuf);
      CloseHandle(fhndOut);
      result := ERROR_SUCCESS;
    End
    else
      result := GetLastError;

    CloseHandle(fhndIn);
  End
  else
    result := GetLastError;
end;