I have been using the Lazarus/FPC Blowfish library to encrypt file streams a while, and it works very well for me.
Now I tried to adapt the library to encrypt and decrypt arbitrary memory structures (records, but also strings), and got a problem which I could not resolve in days, so please help.
Problem is that strings having a length beeing an exact multiple of the Blowfish block size (8 Bytes) are encrypted and decrypted properly. If a string does not end at an exact 8 Byte boundary, the characters exceeding the boundary are mangled.
Here is the code (for the complete Lazarus project please follow the link)
Link to Lazarus project zip
Procedure BlowfishEncrypt(var Contents;ContentsLength:Integer;var Key:String);
// chop Contents into 64 bit blocks and encrypt using key
var
arrShadowContent:Array of Byte absolute Contents;
objBlowfish: TBlowFish;
BlowfishBlock: TBFBlock;
ptrBlowfishKey:PBlowFishKey;
p1,count,maxP:integer;
begin
ptrBlowfishKey := addr(Key[1]);
objBlowfish := TBlowFish.Create(ptrBlowfishKey^,Length(Key));
p1 := 0;
maxP := ContentsLength - 1;
count := SizeOf(BlowfishBlock);
while p1 < maxP do
begin
fillChar(BlowfishBlock,SizeOf(BlowfishBlock),0); // only for debugging
if p1 + count > maxP then
count := ContentsLength - p1;
Move(arrShadowContent[p1],BlowfishBlock,count);
objBlowfish.Encrypt(BlowfishBlock);
Move(BlowfishBlock,arrShadowContent[p1],count);
p1 := p1 + count;
end;
FreeAndNil(objBlowfish);
end;
And this is the call ...
procedure TForm1.CryptButtonClick(Sender: TObject);
var
ContentsBuffer,Key:String;
begin
ContentsBuffer := PlainTextEdit.Text;
Key := KeyTextEdit.Text;
BlowFishEncrypt(ContentsBuffer,Length(ContentsBuffer),Key);
CryptOutEdit.Text := ContentsBuffer;
BlowFishDecrypt(ContentsBuffer,Length(ContentsBuffer),Key);
CryptCheckEdit.Text := ContentsBuffer;
end;
And here you see what's happening:
Screenshot of Test GUI
Resolved. The problem is that I am not allowed to truncate a TBFBlock. For Blowfish Decryption to work, ContetLength must be a multiple of TBFBlock size.
Related
I am trying to write a detailed error message to the system log using the ReportEventW function. Unfortunately, I am encountering problems which are apparently related to the limits within the function but I can't find any real documentation of them: there is a documented limit on dwDataSize and another limit on the maximum length of each string. I am not violating any of these limits, but I am still receiving a FALSE and GetLastError reports RPC_S_INVALID_BOUND.
Through testing, I found that for my test case the limit is caused by the number of strings (wNumStrings), with 203 being the most I can put through correctly (additionally, for 204-206 strings the ReportEventW will return a TRUE but will not write to the log!). If I add 1024 dummy characters to the first line, I once again get an error and have to decrease the number of lines, as far as I can tell, by the same number of characters I added earlier, which would indicate that some total character limit on the whole message is coming to play. Unfortunately, I can't match it against any documented limit even if I ignore what the limits should apply to - my value of about 33300 characters is close to the value 31839 characters (max. length of each string), but sufficiently higher than that to make me discard the theory that the limit on a length of individual string also applies to the total length of the whole message. Apparently, if I add extra raw data, the limit goes down again, which suggests a limitation on the size of the whole event log record.
My questions are:
1) Does anyone know the actual limits for writing to the event log?
2) Do these limits change with the different operating systems? All my tests were performed on Win10 x64, but I have a nasty suspicion that with different OSes, I will encounter a different limitation.
3) Is this documented somewhere?
Thanks.
Actual code (added on request)
procedure WriteToEventLog(const Messages: array of string; const RawData: AnsiString);
const
MaxStringCount = High(Word); // je to WORD! Realne se limit zda byt mnohem mensi
MaxRawDataLen = 61440;
EmptyMessage = #0#0#0#0;
type
TPCharArray = array[0..65535] of PChar;
var
Handle: THandle;
Msgs: ^TPCharArray;
MsgCount: integer;
DataPtr: PAnsiChar;
DataLen: integer;
i: Integer;
begin
MsgCount := Length(Messages);
if MsgCount > MaxStringCount then
MsgCount := MaxStringCount;
Msgs := AllocMem(MsgCount * Sizeof(PChar));
try
for i := 0 to Pred(MsgCount) do
begin
if Messages[i] = ''
then Msgs[i] := EmptyMessage
else Msgs[i] := PChar(Messages[i]);
end;
if RawData = '' then
begin
DataPtr := nil;
DataLen := 0;
end
else
begin
DataPtr := #RawData[1];
DataLen := Length(RawData);
if DataLen > MaxRawDataLen then
DataLen := MaxRawDataLen;
end;
Handle := RegisterEventSource(nil, PChar(ParamStr(0)));
if Handle <> 0 then
begin
try
ReportEvent(Handle, EVENTLOG_ERROR_TYPE, 0, 0, nil, MsgCount, DataLen, Msgs, DataPtr);
finally
DeregisterEventSource(Handle);
end;
end;
finally
FreeMem(Msgs);
end;
end;
It is called with Messages array containing rows from an EurekaLog report (one row per message, about 300 rows).
I can't answer your questions comprehensively, but I just ran into a similar issue. I only used the wNumStrings and lpStrings parameters and, contrary to documentation, still received the RPC_S_INVALID_BOUND error code (1734). On a nagging suspicion, I reduced the number of strings to 256 and it worked. Sure enough, it failed with 257. This was true regardless of the size of the individual strings. There are probably upper limits for individual strings and total message size too, but I didn't bother figuring those out.
TL/DR: wNumStrings <= 256
I don't work with Pascal very often so I apologise if this question is basic. I am working on a binary file program that writes an array of custom made records to a binary file.
Eventually I want it to be able to write multiple arrays of different custom record types to one single binary file.
For that reason I thought I would write an integer first being the number of bytes that the next array will be in total. Then I write the array itself. I can then read the first integer type block - to tell me the size of the next blocks to read in directly to an array.
For example - when writing the binary file I would do something like this:
assignfile(f,MasterFileName);
{$I-}
reset(f,1);
{$I+}
n := IOResult;
if n<> 0 then
begin
{$I-}
rewrite(f);
{$I+}
end;
n:= IOResult;
If n <> 0 then
begin
writeln('Error creating file: ', n);
end
else
begin
SetLength(MyArray, 2);
MyArray[0].ID := 101;
MyArray[0].Att1 := 'Hi';
MyArray[0].Att2 := 'MyArray 0 - Att2';
MyArray[0].Value := 1;
MyArray[1].ID := 102;
MyArray[1].Att1:= 'Hi again';
MyArray[1].Att2:= MyArray 1 - Att2';
MyArray[1].Value:= 5;
SizeOfArray := sizeOf(MyArray);
writeln('Size of character array: ', SizeOfArray);
writeln('Size of integer var: ', sizeof(SizeOfArray));
blockwrite(f,sizeOfArray,sizeof(SizeOfArray),actual);
blockwrite(f,MyArray,SizeOfArray,actual);
Close(f);
Then you could re-read the file with something like this:
Assign(f, MasterFileName);
Reset(f,1);
blockread(f,SizeOfArray,sizeof(SizeOfArray),actual);
blockread(f,MyArray,SizeOfArray,actual);
Close(f);
This has the idea that after these blocks have been read that you can then have a new integer recorded and a new array then saved etc.
It reads the integer parts of the records in but nothing for the strings. The record would be something like this:
TMyType = record
ID : Integer;
att1 : string;
att2 : String;
Value : Integer;
end;
Any help gratefully received!!
TMyType = record
ID : Integer;
att1 : string; // <- your problem
That field att1 declared as string that way means that the record contains a pointer to the actual string data (att1 is really a pointer). The compiler manages this pointer and the memory for the associated data, and the string can be any (reasonable) length.
A quick fix for you would be to declare att1 something like string[64], for example: a string which can be at maximum 64 chars long. That would eliminate the pointer and use the memory of the record (the att1 field itself, which now is a special static array) as buffer for string characters. Declaring the maximum length of the string, of course, can be slightly dangerous: if you try to assign the string a string too long, it will be truncated.
To be really complete: it depends on the compiler; some have a switch to make your declaration "string" usable, making it an alias for "string[255]". This is not the default though. Consider also that using string[...] is faster and wastes memory.
You have a few mistakes.
MyArray is a dynamic array, a reference type (a pointer), so SizeOf(MyArray) is the size of a pointer, not the size of the array. To get the length of the array, use Length(MyArray).
But the bigger problem is saving long strings (AnsiStrings -- the usual type to which string maps --, WideStrings, UnicodeStrings). These are reference types too, so you can't just save them together with the record. You will have to save the parts of the record one by one, and for strings, you will have to use a function like:
procedure SaveStr(var F: File; const S: AnsiString);
var
Actual: Integer;
Len: Integer;
begin
Len := Length(S);
BlockWrite(F, Len, SizeOf(Len), Actual);
if Len > 0 then
begin
BlockWrite(F, S[1], Len * SizeOf(AnsiChar), Actual);
end;
end;
Of course you should normally check Actual and do appropriate error handling, but I left that out, for simplicity.
Reading back is similar: first read the length, then use SetLength to set the string to that size and then read the rest.
So now you do something like:
Len := Length(MyArray);
BlockWrite(F, Len, SizeOf(Len), Actual);
for I := Low(MyArray) to High(MyArray) do
begin
BlockWrite(F, MyArray[I].ID, SizeOf(Integer), Actual);
SaveStr(F, MyArray[I].att1);
SaveStr(F, MyArray[I].att2);
BlockWrite(F, MyArray[I].Value, SizeOf(Integer), Actual);
end;
// etc...
Note that I can't currently test the code, so it may have some little errors. I'll try this later on, when I have access to a compiler, if that is necessary.
Update
As Marco van de Voort commented, you may have to do:
rewrite(f, 1);
instead of a simple
rewrite(f);
But as I replied to him, if you can, use streams. They are easier to use (IMO) and provide a more consistent interface, no matter to what exactly you try to write or read. There are streams for many different kinds of I/O, and all derive from (and are thus compatible with) the same basic abstract TStream class.
I have delphi application, i need to rewrite it for OS X.
This app writes/reads data to/from HID-device.
I have issues when i'm trying to write string from mac.
Here is the line that i'm writing(from debugger on windows): 'Новый комплекс 1'
and this works good. Meanwhile if copy this from debugger to somewhere it becomes 'Íîâûé êîìïëåêñ 1'. Device shows it as it was written, in cyrillic. And that's OK.
When i'm trying to repeat this steps on OS X, device shows unreadeble symbols. But if i do hardcode 'Íîâûé êîìïëåêñ 1' from windows example it's OK again.
Give some hints.
How it on windows
Some code:
s:= 'Новый комлекс 1'
s:= AnsiToUtf8(ReplaceNull(s));
Here is ReplaceNULL:
function ReplaceNull(const Input: string): string;
var
Index: Integer;
Res: String;
begin
Res:= '';
for Index := 1 to Length(Input) do
begin
if Input[Index] = #0 then
Res:= Res + #$12
else
Res:= Res + Input[Index];
end;
ReplaceNull:= Res;
end;
this string i put to Tstringlist and then save to file:
ProgsList.SaveToFile(Mwork.pathLibs+'stream.ini', TEncoding.UTF8);
Other program read this list and then writes to device:
Progs:= TStringList.Create();
Progs.LoadFromFile(****);
s:= UTF8ToAnsi(stringreplace(Progs.Strings[i], #$12, #0, [rfReplaceAll, rfIgnoreCase]));
And then write it to device.
So the line wich writes seems like this:
"'þ5'#0'ÿ'#$11'Новый комплекс 1'#0'T45/180;55;70;85;90;95;100;T45/180'#0'ÿ'"
On the mac i succesfully get the same string. But device can't show this in cyrillic.
A Delphi string is encoded in UTF-16 on all platforms. There is no need to convert it, unless you are interacting with non-Unicode data outside of your app.
That being said, if you have a byte array that is encoded in a particular charset, you can convert it to another charset using Delphi's TEncoding.Convert() method. You can use the TEncoding.GetEncoding() method to get a TEncoding object for a particular charset (if different than the standard supported charsets - ANSI, ASCII, UTF-7, UTF-8, and UTF-16 - which have their own property getters in TEncoding).
var
SrcEnc, DstEnc: TEncoding;
SrcBytes, ConvertedBytes: TBytes;
begin
SrcBytes := ...; // Cyrillic encoded bytes
SrcEnc := TEncoding.GetEncoding('Cyrillic'); // or whatever the real name is...
try
DstEnc := TEncoding.GetEncoding('Windows-1251');
try
ConvertedBytes := TEncoding.Convert(SrcEnc, DstEnc, SrcBytes);
finally
DstEnc.Free;
end;
finally
SrcEnc.Free;
end;
// use ConvertedBytes as needed...
end;
Update: To encode a Unicode string in a particular charset, simply call the TEncoding.GetBytes() method, eg:
s := 'Новый комлекс 1';
Enc := TEncoding.GetEncoding('Windows-1251');
try
bytes := Enc.GetBytes(s);
finally
Enc.Free;
end;
s := 'Новый комлекс 1';
bytes := TEncoding.UTF8.GetBytes(s);
You can use the TEncoding.GetString() to decode bytes in a particular charset back to a String, eg:
bytes := ...; // Windows-1251 encoded bytes
Enc := TEncoding.GetEncoding('Windows-1251');
try
s := Enc.GetString(bytes);
finally
Enc.Free;
end;
bytes := ...; // UTF-8 encoded bytes
s := TEncoding.UTF8.GetString(bytes);
The answer was next. Delphi Berlin 10.1 uses KOI8-R, and my device - cp1251.
As i'd wanted to write russian symbols(Cyrillic) i've created table of matches for symbols from KOI8-R and cp1251.
So, i take string in KOI8-R make it in cp1251.
Simple code:
Dict:=TDictionary<String,String>.Create;
Dict.Add(#$439,#$E9);//'й'
Dict.Add(#$44E,#$FE);//'ю'
Dict.Add(#$430,#$E0);//'а'
....
function tkoitocp.getCP1251Code(str:string):string;
var i:integer; res,key,val:string; pair:Tpair<String,String>;
begin
res:='';
for i:=1 to length(str) do
begin
if dict.ContainsKey(str[i]) then
begin
pair:= dict.ExtractPair(str[i]);
res:=res+pair.Value;
dict.Add(pair.Key,pair.Value);
end
else
res:=res+str[i];
end;
Result:=res;
end;
I have tried the following code (and varients) without any sucess, nor can I find any examples of how to call these Windows Functions from Delphi out there. Any clues would be very gratefully received.
The CryptProtectMemory does appear to produce some possibly encrypted result, but the unprotect does not change that result at all.I suspect I have done something charactisticly stupid, but I havent found it all day...
function WinMemEnc(PlnTxt: String): String;
var
Enc: Pointer;
j: Integer;
EncSze: Cardinal;
ws: String;
const
CRYPTPROTECTMEMORY_SAME_PROCESS: Cardinal = 0;
EncryptionBlockSize: Integer = 8;
begin
if Length(PlnTxt) mod EncryptionBlockSize = 0 then
j := Length(PlnTxt)
else
j := ((Length(PlnTxt) div 8) + 1) * 8;
ws := StringofChar(' ', j);
Move(PlnTxt[1], ws[1], j);
Enc := Pointer(ws);
EncSze := j * 2;
if CryptProtectMemory(Enc, EncSze, CRYPTPROTECTMEMORY_SAME_PROCESS) then
begin
Setlength(Result, j);
Move(Enc, Result[1], EncSze);
end;
end;
function WinMemDcr(EncInp: String): String;
var
Enc: Pointer;
j: Integer;
EncSze: Cardinal;
ws: String;
const
CRYPTPROTECTMEMORY_SAME_PROCESS: Cardinal = 0;
begin
j := Length(EncInp);
EncSze := j * 2;
ws := EncInp;
Enc := Pointer(ws);
if CryptUnprotectMemory(Enc, EncSze, CRYPTPROTECTMEMORY_SAME_PROCESS) then
begin
Setlength(Result, j);
Move(Enc, Result[1], EncSze);
end;
end;
You have set EncryptionBlockSize := 8; while in my library CRYPTPROTECTMEMORY_BLOCK_SIZE = 16.
You also mistakenly move only half of the input string to ws, because j holds the length of the string while Move() moves Count number of bytes. A Unicode Char is 2 bytes.
As said in the comments, encryption/decryption works on bytes and storing an encryption in a string is a potential disaster.
So here's my suggestion for a encryption/decryption of a string with encrypted storage in TBytes.
function MemEncrypt(const StrInp: String): TBytes;
begin
Result := TEncoding.Unicode.GetBytes(StrInp);
if Length(Result) mod CRYPTPROTECTMEMORY_BLOCK_SIZE <> 0 then
SetLength(Result, ((Length(Result) div CRYPTPROTECTMEMORY_BLOCK_SIZE) + 1) * CRYPTPROTECTMEMORY_BLOCK_SIZE);
if not CryptProtectMemory(Result, Length(Result), CRYPTPROTECTMEMORY_SAME_PROCESS) then
raise Exception.Create('Error Message: '+IntToStr(GetLastError));
end;
function MemDecrypt(const EncInp: TBytes): String;
var
EncTmp: TBytes;
begin
EncTmp := Copy(EncInp);
if CryptUnprotectMemory(EncTmp, Length(EncTmp), CRYPTPROTECTMEMORY_SAME_PROCESS) then
result := TEncoding.Unicode.GetString(EncTmp)
else
raise Exception.Create('Error Message: '+IntToStr(GetLastError));
end;
In the decryption a copy of the input TBytes is made to preserve the encrypted data.
And finally a test procedure:
procedure TForm13.Button2Click(Sender: TObject);
const
Txt = '1234567890123456789012345678901';
var
s: string;
b: TBytes;
begin
s := Txt;
Memo1.Lines.Add(s);
b := MemEncrypt(Txt);
s := MemDecrypt(b);
Memo1.Lines.Add(s);
end;
Without testing it (purely from the looks of your code), I believe the problem lies in the MOVE statement:
Move(Enc, Result[1], EncSze);
You are moving data from the location of the pointer - not from the data that the pointer is pointing to.
You should use
Move(Enc^, Result[1], EncSze);
to move data from the location that is POINTED TO by the pointer, and not from the pointer itself.
To clarify: The Enc variable is - say - located at address $12345678 and the data you are manipulating is located at address $99999999
This means that at address $12345678 is located 4 bytes ($99 $99 $99 and $99). And at address $99999999 is located the data you are manipulating.
The statement
Move(Enc, Result[1], EncSze);
thus moves EncSize bytes from the address $12345678 to the 1st character of the string variable Result. This you do not want, as it will only move 4 bytes of $99 and then whatever follows at address $1234567C and on.
To move data from the address $99999999 you need to tell the compiler, that you want to move data from the location POINTED TO by the pointer, and not from the POINTER itself:
Move(Enc^, Result[1], EncSze);
But other that that, I agree with David. You should stop using strings as storage for non-string data. It'll bite you in the a** at some point. Use a byte array (TBytes) instead.
1.this is my code i want to read a record from a text file into array in pascal my program is about making a hotel helper and i already have a text file with the data of the hotel then i should read it from the text file and store it in array .. but i am facing error 103 exit code (file not open).... any help Please . :)
program Hotel1(input,output);
const max =10; MaxFloor =10;
type
Date = record
day :1..31;
month:1..12;
year:integer;
end;
Booking = record
Guest:string[20];
S_Date:date;
E_date:date;
end;
Booking_Mat= array[1..max] of Booking;
History_Booking = record
B_num:integer;
B_Mat:Booking_Mat;
end;
Room = record
Num:integer;
Bed_num:integer;
Price:integer;
Status:Boolean;
H:History_Booking;
end;
Data = record
Ro:Room;
m:integer;
end;
Data_mat= array [1..max] of Data;
Procedure Read_Data(filename:string; var table:Data_mat);
var df:text; i,j :integer;
n,m,num,GN:integer;
Bed_num,Price:integer;
f:text;
s,e:Date;
Gname:string[20];
ok:boolean;
a:Data_mat;
c:char;
Begin
writeln('Reading ',filename,' records into array.... ');
assign(df,filename);
reset(df);
i:=0;
while (not eof) do
begin
i:=i+1;
Read (f,num);
a[i].Ro.num:=num;
Read (f,Bed_num);
a[i].Ro.Bed_num:=Bed_num;
Read (f,Price);
a[i].Ro.Price:=Price;
Read(f,c);
if (c ='Y') then
a[i].Ro.status:= true
else
a[i].Ro.status:= false;
readln;
End; {while eof}
close(df);
End; {Read_Data}
You've declared two variables of type Text, (df and f) in your var block.
You open df with these lines:
assign(df,filename);
reset(df);
You then read from f (which is not the file you opened above) in several lines, such as this one:
Read (f, num);
It's interesting to note that you actually manage to close the file you really opened, even though you never use it in your loop:
close(df);
The solution to all of these issues is to delete the declaration of either f or df, and then fix the compiler errors you get by correcting the code to use the remaining text variable. (Two important lessons here are
Only declare the variables you actually need.
Use the variables you declare.
Your loop is also invalid, because you're using while not eof with no file provided for which to test the end. Your loop should read while not Eof(df) do instead.
It's also much better to follow the typical naming convention of prefixing types with a T. It makes it clear that it's a type and not a variable, and allows you to read the code more easily. For instance, I'd change your definition of Data to TRoomData, and change the other type declarations accordingly. Here's an example - note that TRoomData now has a field (member) named Room of type TRoom:
TRoomData = record
Room: TRoom;
m: Integer;
end;
TRoom is defined as
TRoom = record
Num: Integer;
Bed_num: Integer;
Price: Integer;
Status: Boolean;
H: THistory_Booking;
end;
And so forth. This allows you to write code more clearly:
var
RoomData: TRoomData;
begin
RoomData.Room.Num := 1;
RoomData.Room.Price := 50;
// etc.
end;
With all that being said, your file does not contain text, and therefore you're using the wrong file type by using df: Text in the first place. You should use a File of TRoomData, allowing you to read and write entire records at a time. Here's an example of doing so:
var
DF: File of TRoomData;
RoomData: TRoomData;
i: Integer;
const
DataFileName = 'D:\TempFiles\RoomData.dat';
Writing it:
// Put some data into the record
RoomData.Room.Num := 1;
RoomData.Room.Bed_num := 1;
RoomData.Room.Price := 40;
RoomData.Room.Status := True;
RoomData.Room.H.B_num := 1;
for i := 1 to Max do
begin
RoomData.Room.H.B_Mat[1].Guest := Format('Guest %d', [i]);
RoomData.Room.H.B_Mat[1].S_Date.Year := 2014;
RoomData.Ro.H.B_Mat[1].S_Date.Month := i;
RoomData.Ro.H.B_Mat[1].S_Date.Day := i;
end;
// Write it out to the file
AssignFile(DF, DataFileName);
try
Rewrite(DF);
Write(DF, RoomData);
finally
CloseFile(DF);
end;
Reading it back in:
AssignFile(DF, DataFileName);
try
Reset(DF);
Read(DF, RoomData);
finally
CloseFile(DF);
end;
(Or, better yet: If the version of Pascal you're using supports it, move away from the old file I/O routines and start using TFileStream instead.)
Last but not least, learn to properly format your code. It makes it much easier to debug and maintain, and it's much easier to read when you can follow the execution path clearly.