Konverzija fajla u binarne brojeve:
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;
Konverzija fajla koji se sastoji od binarnih brojeva u normalan oblik:
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;
Btw, BinToFile() radi mnogo sporo za velike fajlove, recimo za fajl od 175mb mu treba oko 5-10 minuta da ga vrati u normalan oblik.