I use the CiaComPort in Delphi5, and I have a problem. I send a command to the device. I use the Send(Buffer: Pointer; Len: integer): cardinal function.
procedure TFormMain.CiaComportraParancsotKuld(CNev, Szoveg: WideString; NyoId, PortSzam: Integer);
var
Kar: PChar;
Szam: Integer;
Parancs: WideString;
begin
Parancs := #$0002+'~JS0|'+CNev+'|0|'+Szoveg+#$0003;
Kar := PChar(Parancs);
Szam := length(Parancs)*2;
FormMain.CiaComPort1.Open := True;
FormMain.CiaComPort1.Send(Kar, Szam);
FormMain.CiaComPort1.Open := False;
end;
This procedure is fine, but when I send the command, unfortunately I don't see the coming characters from the device, because In my opinion I do not use the CiaComPort1DataAvailable(Sender: TObject) well.
//Receive(Buffer: Pointer; Len: integer): cardinal
procedure TForm1.CiaComPort1DataAvailable(Sender: TObject);
var
Kar: PChar;
Szam: Integer;
Parancs: WideString;
begin
Szam := RxCount;
Parancs := WideString(Receive(Kar, Szam)); //I think that's not good.
Memo1.Lines.Add(Parancs);
end;
Unfortunately I can't read the buffer. Do you have any ideas?
Evidently, RxCount tells you how many bytes you received. The Receive function expects you to give it a buffer, and then it will fill that buffer, up to the size you tell it. In your code, you've provided the size, but you haven't provided a buffer. You need to allocate space for the buffer. If you use the WideString as your buffer, then you allocate space with SetLength:
Szam := RxCount;
SetLength(Parancs, Szam div 2);
Receive(PWideChar(Parancs), Szam);
I don't know what the return value of Receive means, so I have not demonstrated its use here. I'm sure if you check the documentation, you can learn what it's for.
Related
Consider:
function OuterFunc: integer;
function InnerFunc: integer;
begin
// Here I'd like to access the OuterFunc.Result variable
// for both reading and writing its value
OuterFunc.Result := OuterFunc.Result + 12;
end;
begin
end;
Is there a native syntax to access the OuterFunc Result variable inside InnerFunc? Or is the only way to do this to pass it like a parameter, as in the following?
function OuterFunc: integer;
function InnerFunc(var outerResult: integer): integer;
begin
end;
var
i: integer;
begin
i := InnerFunc(Result);
end;
You can assign result to functions by assigning to the function name, which actually was the original way in Pascal:
function MyFunc: integer;
begin
MyFunc := 2;
// is equal to the following
Result := 2;
end;
So in your case you can write
function OuterFunc: integer;
function InnerFunc: integer;
begin
OuterFunc := 12;
end;
begin
end;
Beware however, that using the function name in a statement block anyware else than on the left side of the assignment operator results in a recursive call, and is therefore different from how the predefined Result works.
In other words, you can not access a previously set value of OuterFunc from within InnerFunc. You would need to use e.g. a local variable in the outer scope defined before InnerFunc to be accessible also from InnerFunc:
function OuterFunc: integer;
var
OuterResult: integer;
function InnerFunc: integer;
begin
OuterResult := 0;
OuterResult := OuterResult + 12;
end;
begin
Result := OuterResult;
end;
For more details refer to Function Declarations in the documentation.
Another option, except for using the native Pascal syntax (as displayed by Tom Brunberg's answer), is converting the local function into a procedure.
function OuterFunc: integer;
procedure InnerFunc(out innerResult: integer);
begin
{OuterFunc's} Result := 0;
innerReuslt := -1;
end;
var
i: integer;
begin
InnerFunc( i );
end;
Since this is your INNER local function you would not break some external API/contract by this simple change.
Twice so since your original code has InnerFunc being the de facto procedure, making no use of its own Result neither by caller, nor by callee.
function OuterFunc: integer;
// function InnerFunc: integer;
procedure InnerFunc;
begin
// here i'd like to access OuterFunc.Result variable
// for both reading and writing its value
// OuterFunc.Result := OuterFunc.Result + 12;
Result := Result + 12;
end;
begin
InnerFunc();
end;
But okay, let's assume you just forgot using BOTH results of BOTH functions, but you did originally intend to.
Still there are few ways at your disposal to cut corners and to hack over the Delphi language intentions-limitations.
Starting with that procedure approach, you may add a function shorthand, if you want to use such a function in expressions.
Though it looks a bit ugly and adds a redirection call for the CPU (you can not inline local functions and if you could Delphi inline implementation is bogged with "register dances"), so slows things down somewhat (but depending on how much you call it w.r.t. other work - that extra work might be non-noticeable).
function OuterFunc: integer;
procedure InnerFunc(out innerResult: integer); overload;
begin
innerResult := +2;
// {OuterFunc's} Result := Result + innerResult;
Inc( Result, innerResult );
end;
function InnerFunc: integer; overload;
begin
InnerFunc( Result );
end;
var
i: integer;
begin
// InnerFunc( i );
i := InnerFunc();
end;
And yet another hack is declaring the variables overlapping.
function OuterFunc: integer;
var Outer_Result: integer absolute Result;
i: integer;
function InnerFunc: integer;
begin
Result := +2;
Inc( Outer_Result, Result );
end;
begin
i := InnerFunc();
end;
Now, this approach might kill the optimizations, like placing the "result" in the CPU registers, forcing using the RAM for it, which is slower.
Additionally, once you might wish to change the type of the OuterFunc and if you forget to change the type of the Outer_Result var accordingly - you screwed yourself.
function OuterFunc: double; // was - integer; Proved to be not enough since 2020
var Outer_Result: integer absolute Result; // and here we forgot to sync type changing.... ooooops!
i: integer;
function InnerFunc: integer;
....
So less hackish way to express that intention (at the price of allocating and accessing yet one more in-RAM variable) would be this:
function OuterFunc: integer;
{$T+} // we need to enable type checking: predictability is safety
var Outer_Result: ^integer;
i: integer;
function InnerFunc: integer;
begin
Result := +2;
Inc( Outer_Result^, Result );
end;
begin
Outer_Result := #Result;
i := InnerFunc();
end;
But all these options are hack-arounds, breaking conceptual clarity, thus hampering ability for people to read/understand the program in the future.
If you need the variable - then do declare the variable. That would be the most clear option here. Afterall programs are more written for the future programmers to read them than for the computers to compile them. :-)
function OuterFunc: integer;
var the_Outer_Result: integer;
function InnerFunc;
begin
Result := +2;
Inc( the_Outer_Result, Result );
end;
var
i: integer;
begin
the_Outer_Result := 0;
.....
I := InnerFunc();
.....
Result := the_Outer_Result;
end;
That way you would not fight with the language, but give up and use it as it was intended to use. Fighting and outsmarting the language is always fun, but in the long term, when you have to maintain the code any human being last read 5 years ago and port it to newer versions of Delphi/libraries/Windows - then such the non-natural smart tricks tend to become quite annoying.
I want to get info_hash of *.torrent file using Delphi.
Tried this BEncode decorder.
But it gives crazy characters when decode.
Any other working BEncode decoder in Delphi? Or anything I'm doing wrong?
This is my code:
procedure TForm.Button1Click(Sender: TObject);
var
be: TBEncoded;
fs: tfilestream;
op: string;
begin
fs := tfilestream.Create('xx.torrent', fmOpenReadWrite);
be := TBEncoded.Create(fs);
be.Encode(be.ListData.Items[0].Data, op);
showmessage(op);
be.Encode(be.ListData.FindElement('info'), op);
showmessage(op);
end;
I've just tried this decoder, it's working normally. You didn't need to use Encode procedure, its purpose (as seen from name) is to encode elements back to BEncode. That's test program that shows torrent information in TMemo:
procedure ShowDecoded(be: TBEncoded; indent: string='');
var i: Integer;
begin
with form1.Memo1.Lines do
case be.Format of
befstring: Add(indent+be.StringData);
befInteger: Add(indent+IntToStr(be.IntegerData));
befList: begin
Add(indent+'list');
for i:=0 to be.ListData.Count-1 do
ShowDecoded(be.ListData.Items[i].Data as TBEncoded,indent+' ');
Add(indent+'end of list');
end;
befDictionary: begin
Add(indent+'dict');
for i:=0 to be.ListData.Count-1 do begin
Add(indent+' '+be.ListData.Items[i].Header+'=');
ShowDecoded(be.listData.Items[i].Data as TBEncoded,indent+' ');
end;
Add(indent+'end of dict');
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var fs: TFileStream;
be: TBEncoded;
i: Integer;
begin
if OpenDialog1.Execute then begin
fs:=TFileStream.Create(OpenDialog1.FileName,fmOpenRead);
try
be:=TBEncoded.Create(fs);
ShowDecoded(be);
be.Free;
finally
fs.Free;
end;
end;
end;
That's test result:
dict
created by=
uTorrent/3.4.3
creation date=
1439626950
encoding=
UTF-8
info=
dict
length=
1345178
name=
Алябьев А., Лист Ф. - Соловей - 1987.pdf
piece length=
16384
pieces=
)Lo.Î ’üXí»IÙçsáôt£ˆb›hŒˆ*Ð誺š¤/N7’`0âÓ†nË5&T€:V•Ìפ¯9¤Ý:¦J©Ï|Œ•A¥,¼R¯þ:H:X&…¢<¸º"2îV-vÀÖˆD†¨¬ß‰ƒ,ümjà?éÛoe¬r£{¨¾]•4òØžhô†›¼AØBeJÕÌ4³·Œ‹¶ËAG— f„\pa
end of dict
end of dict
I'd make some changes to BEncode unit, there is mess in there: raising empty exceptions, unsafe cast: TBEncoded(object) instead of "object as TBEncoded",
checking for nil object before object.free, which is tautology, but in general it works.
Update 1
Simple code to take one of the fields, 'pieces' and show in hex.
procedure FindAndShowHash(be: TBEncoded);
var i: Integer;
s: string;
infoChunk, piecesChunk: TBencoded;
begin
s:='';
infoChunk:=be.ListData.FindElement('info') as TBencoded;
piecesChunk:=infoChunk.ListData.FindElement('pieces') as TBencoded;
for i:=1 to Length(piecesChunk.StringData) do
s:=s+IntToHex(Byte(piecesChunk.StringData[i]),2);
form1.Memo1.Lines.Add('Hash function:');
form1.Memo1.Lines.Add(s);
end;
As you see, we access StringData char by char and cast it as Byte. I just showed it in hex, of course you can use these bytes for further processing.
Beware: you'll get LOADS of hex values, this is not MD5 hash or any other hash of WHOLE torrent, it's sequence of hash functions for each piece of data, usually blocks of 1 or 2 MB.
UPDATE 2
This unit can be used in newer versions of Delphi, all you need to do is to replace ALL string variables in it from 'string' to 'ANSIstring', just with Ctrl+R - ':string' replace to ':ANSIstring'.
UPDATE 3
OK, finally I get it. Here is procedure which computes info_hash and shows it in hex, this requires newer version of Delphi. Also, add IdGlobal and IdHashSHA to 'uses' section.
procedure makeInfoHash(be: TBEncoded);
var SHA1: TIdHashSHA1;
s: string;
infoChunk: TBencoded;
infoEncoded: ANSIString;
bytes: TIdBytes;
begin
infoChunk:=be.ListData.FindElement('info') as TBencoded;
TBencoded.Encode(infoChunk,infoEncoded);
bytes:=RawToBytes(infoEncoded[1],Length(infoEncoded));
SHA1:=TIdHashSHA1.Create;
try
s:=SHA1.HashBytesAsHex(bytes);
finally
SHA1.Free;
end;
Form1.Memo1.Lines.Add(s);
end;
It gives correct info_hash, the same which is displayed in uTorrent, like this:
7D0487D3D99D9C27A7C09CDCBB2F2A8034D4F9BF
You must replace all string to ANSIstring in BENcode.pas, as said in update 2. Enjoy!
I have scowered the net trying to find an example of a function, how to hash text with Sha1 and DCPcrypt.
I have the below example. Seems to pop up the whole time.
But it returns chinese characters every time. Please assist in corecting the function.
function TForm1.EncryptThis(aString : string) : string;
var
Cipher: TDCP_cast256;
KeyStr: string;
begin
KeyStr:= '';
Cipher:= TDCP_cast256.Create(Self);
Cipher.InitStr(KeyStr,TDCP_sha1);
result := Cipher.EncryptString(aString);
Cipher.Burn;
Cipher.Free;
end;
UPDATE:
Using the links and info belowe, I built these functions. But as I said, This does not make alot of sense to me. So please excuse the ignorance.
THe code however does not work. Its output is: 3F3F3F3F3F3F3F3F3F3F00000000000000000000 whereas it should be 40bd001563085fc35165329ea1ff5c5ecbdbbeef since i told the program to has 123.
Please help.
function CalcDigest(text: string): string;
var
x: TDCP_hash;
begin
x := TDCP_sha1.Create(nil);
try
x.Init;
x.UpdateStr(text);
SetLength(Result, x.GetHashSize div 8);
x.Final(Result[1]);
finally
x.Free;
end;
end;
function String2Hex(const Buffer: Ansistring): string;
begin
SetLength(result, 2*Length(Buffer));
BinToHex(#Buffer[1], PWideChar(#result[1]), Length(Buffer));
end;
procedure TForm1.Button1Click(Sender: TObject);
var
I: Integer;
begin
memo2.Lines.Add(String2Hex(CalcDigest(memo1.Lines.Strings[0])));
end;
Judging by this, you can do it this way:
function CalcDigest(text: string): string;
var
x: TDCP_hash;
begin
x := TDCP_sha1.Create(nil);
try
x.Init;
x.UpdateStr(text);
SetLength(Result, x.GetHashSize div 8);
x.Final(Result[1]);
finally
x.Free;
end;
end;
You may want to encode the hash before printing, because the output is binary. See for example this question.
I am not very familiar with DCPCrypt. You can also use other libraries.
1) Indy - usually included in Delphi
function SHA1Text(const s: string): string;
begin
with TIdHashSHA1.Create do
try
Result:=LowerCase(HashStringAsHex(s));
finally
Free;
end;
end;
2) Wolfgang Ehrhardt's libraries (fastest as far as I know) from
http://www.wolfgang-ehrhardt.de/crchash_en.html
function SHA1Text(const s: string): string;
var
Context: THashContext;
SHA1Digest: TSHA1Digest;
begin
SHA1Init(Context);
SHA1Update(Context, pChar(s), length(s));
SHA1Final(Context, SHA1Digest);
Result:=HexStr(#SHA1Digest, SizeOf(SHA1Digest));
end;
NOTE: it is from Delphi 7. You will need to update it if you use unicode Delphi.
Does anyone know a 100% clone of the C/C++ printf for Delphi?
Yes, I know the System.Format function, but it handles things a little different.
For example if you want to format 3 to "003" you need "%03d" in C, but "%.3d" in Delphi.
I have an application written in Delphi which has to be able to format numbers using C format strings, so do you know a snippet/library for that?
Thanks in advance!
You could use the wsprintf() function from Windows.pas. Unfortunately this function is not declared correctly in the Windows.pas so here is a redeclaration:
function wsprintf(Output: PChar; Format: PChar): Integer; cdecl; varargs;
external user32 name {$IFDEF UNICODE}'wsprintfW'{$ELSE}'wsprintfA'{$ENDIF};
procedure TForm1.FormCreate(Sender: TObject);
var
S: String;
begin
SetLength(S, 1024); // wsprintf can work only with max. 1024 characters
SetLength(S, wsprintf(PChar(S), '%s %03d', 'Hallo', 3));
end;
If you want to let the function look more Delphi friendly to the user, you could use the following:
function _FormatC(const Format: string): string; cdecl;
const
StackSlotSize = SizeOf(Pointer);
var
Args: va_list;
Buffer: array[0..1024] of Char;
begin
// va_start(Args, Format)
Args := va_list(PAnsiChar(#Format) + ((SizeOf(Format) + StackSlotSize - 1) and not (StackSlotSize - 1)));
SetString(Result, Buffer, wvsprintf(Buffer, PChar(Format), Args));
end;
const // allows us to use "varargs" in Delphi
FormatC: function(const Format: string): string; cdecl varargs = _FormatC;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(FormatC('%s %03d', 'Hallo', 3));
end;
It's not recommended to use (ws)printf since they are prone to buffer overflow, it would be better to use the safe variants (eg StringCchPrintF). It is already declared in the Jedi Apilib (JwaStrSafe).
Well, I just found this one:
function sprintf(S: PAnsiChar; const Format: PAnsiChar): Integer;
cdecl; varargs; external 'msvcrt.dll';
It simply uses the original sprintf function from msvcrt.dll which can then be used like that:
procedure TForm1.Button1Click(Sender: TObject);
var s: AnsiString;
begin
SetLength(s, 99);
sprintf(PAnsiChar(s), '%d - %d', 1, 2);
ShowMessage(S);
end;
I don't know if this is the best solution because it needs this external dll and you have to set the string's length manually which makes it prone to buffer overflows, but at least it works... Any better ideas?
more clean approach without unnecessary type casting
function sprintf(CharBuf: PChar; const Format: PAnsiChar): Integer;
cdecl; varargs; external 'msvcrt.dll';
procedure TForm1.Button1Click(Sender: TObject);
var CharBuf: PChar;
begin
CharBuf:=StrAlloc (99);
sprintf(CharBuf, 'two numbers %d - %d', 1, 2);
ShowMessage(CharBuf);
StrDispose(CharBuf);
end;
If you happen to cross compile for Windows CE App. use coredll.dll instead of msvcrt.dll
I want to upgrade my application from Indy 9 to 10 with Delphi 2007.
In this thread there is a call to Indy9 TIdUDPBase.SendBuffer but this won't compile in Indy10 as the method parameter don't exists. The third parameter aBuffer is a var parameter and I didn't find any such method signature in Indy10.
Any alternative method to call ?
procedure TSenderThread.Execute;
var
vTimeData: TTimeDataRecord;
I: Integer;
FElapsed: Int64;
FTimerElappsed,
vLastTimerElappsed: Int64;
begin
vTimeData.Size := SizeOf(TTimeDataRecord);
vTimeData.ClientCount := 1;
Priority := tpHighest;
FIdUDPClient := TIdUDPClient.Create(nil);
FIdUDPClient.BroadcastEnabled := True;
try
while not (Terminated or Application.Terminated) do
begin
Sleep(1000);
//Measure Time frame
vLastTimerElappsed := FTimerElappsed;
QueryPerformanceCounter(FTimerElappsed);
FElapsed := ((FTimerElappsed-vLastTimerElappsed)*1000000) div FFrequency;
vTimeData.TotalTimeFrame := FElapsed;
if FRunning then
begin
FElapsed := ((FTimerElappsed-FStart)*1000000) div FFrequency;
vTimeData.CurrentMessageTime := FElapsed;
end
else
vTimeData.CurrentMessageTime := 0;
//Copy Values
vTimeData.AccumulatedTime := InterlockedExchange(TimeData.AccumulatedTime,0);
vTimeData.MessageCount := InterlockedExchange(TimeData.MessageCount,0);
for I := 0 to TimeClassMax do
vTimeData.TimeClasses[I] := InterlockedExchange(TimeData.TimeClasses[I],0);
// Calls procedure TIdUDPBase.SendBuffer(AHost: string; const APort: Integer; var ABuffer; const AByteCount: integer);
// This is changed in Indy10, unable to compile
FIdUDPClient.SendBuffer('255.255.255.255', UIPerfPort, vTimeData, TimeData.Size);
end;
finally
FreeAndNil(FIdUDPClient);
end;
end;
EDIT:
vTimeData is basically an array of integers.
TTimeDataRecord = record
Size: Integer; //Size of record structure is transfered and compared for safty reasons.
ClientCount: Integer;
AccumulatedTime: Integer; //This is the accumulated time busy in microseconds
CurrentMessageTime: Integer; //This is the time the current message has been processed. If several computers report a high value at the same time it indicates a freeze!
TotalTimeFrame: Integer; //This is the total time measured in microseconds
MessageCount: Integer;
TimeClasses: array [0..TimeClassMax] of Integer;
end;
you have a method with same name
procedure TIdUDPClient.SendBuffer(const AHost: string; const APort: TIdPort;
const ABuffer: TIdBytes);
Instead of an untyped buffer it expects an array of bytes. What is your data like? You just need to write your data as an array of bytes. Something like:
var
Buffer: TIdBytes;
begin
SetLength(Buffer, YourSizeOfData);
Move(YourData, Buffer[0], YourSizeOfData);
FIdUDPClient.SendBuffer('255.255.255.255', UIPerfPort, Buffer);
end;
But as I said it depends on the type of the data. The approach is ok however.
EDIT:
Now that I can see that you have a record you have two options:
Just move the whole record to array of bytes.
Move(#aRecord, Buffer[0], (6 + TimeClassMax) * SizeOf(Integer));
Have a CopyToBytes method in your record that does the actual copy. More general I guess.
TTimeDataRecord = record
Size: Integer; //Size of record structure is transfered and compared for safty reasons.
ClientCount: Integer;
AccumulatedTime: Integer; //This is the accumulated time busy in microseconds
CurrentMessageTime: Integer; //This is the time the current message has been processed. If several computers report a high value at the same time it indicates a freeze!
TotalTimeFrame: Integer; //This is the total time measured in microseconds
MessageCount: Integer;
TimeClasses: array [0..TimeClassMax] of Integer;
procedure CopyToBytes(var Buffer: TIdBytes);
end
Implementation of the CopyToBytes
procedure TTimeDataRecord.CopyToBytes(var Buffer: TIdBytes);
begin
// copy the data however you see fit
end;