PizzaProgram

This is the 2 main functions I'm using ICS with in this thread: function TNtakThread.JWS_Sign(const payload, key1: String): AnsiString; var SObj : ISuperObject; JoseAlg : OverbyteIcsSslJose.TJoseAlg; PrivKey : TSslCertTools; begin Result := ''; JoseAlg := OverbyteIcsSslJose.jsigRsa256; PrivKey := OverbyteIcsSslX509Utils.TSslCertTools.Create(nil); try try PrivKey.ClearAll; PrivKey.PrivateKeyLoadFromText(key1, '') ; SObj := SO(IcsJoseJWSJson(JoseAlg, payload, '', PrivKey.PrivateKey, '', '', '', '')); Result := SObj.AsObject.S['protected'] + '..' + SObj.AsObject.S['signature']; except on E:Exception do ntLOG('JWS ERR: ' + E.Message); end; finally PrivKey.Free; Sobj := nil; end; end; Sending REST requests: function TNtakThread.NTAK_Send1(const url: string; const json: SOString; var hiba: string; var valasz: WideString): Boolean; // "hiba" means: error , "valasz" means: answer var SslHttpCli : TSslHttpCli; SslContext : TSslContext; JsonUTF8 : UTF8String; mySign : AnsiString; lg : integer; // length begin Result := False; hiba := ''; valasz := ''; OverbyteIcsSSLEAY.GSSL_DLL_DIR := SSl3_.path; // '...\Bin\SSL\20211217\'; SslContext := nil; SslHttpCli := TSslHttpCli.Create(nil); SslHttpCli.URL := url; SslHttpCli.ContentTypePost := 'application/jose+json; charset=UTF-8'; SslHttpCli.Accept := 'application/json'; SslHttpCli.SendStream := TMemoryStream.Create; SslHttpCli.RcvdStream := TMemoryStream.Create; try try SslHttpCli.Timeout := 10; // Must be seconds! Not MS !!! ... TODO: ask the author to create a default property: TimeoutMs SslContext := TSslContext.Create(nil); SslContext.SslMinVersion := sslVerTLS1_2; SslContext.SslMaxVersion := sslVerTLS1_3; SSlContext.SslVerifyPeer := False; // := SSL_VERIFY_NONE; SslContext.SslCertLines.Text := cer1; SslContext.SslPrivKeyLines.Text := key1; SslHttpCli.SslContext := SslContext; if cer6464 = '' then // enough to encode once cer6464 := Base64Encode(cer1); SslHttpCli.ExtraHeaders.Add( 'x-certificate: ' + cer6464); mySign := JWS_Sign( json, key1 ); SslHttpCli.ExtraHeaders.Add( 'x-jws-signature: ' + mySign ); JsonUTF8 := UTF8Encode(json); lg := Length(JsonUTF8); SslHttpCli.SendStream.Write(JsonUTF8[1], lg); SslHttpCli.SendStream.Seek(0, soFromBeginning); SslHttpCli.Post; ntLOG( 'Successful sending :-)', -1); except on E:Exception do begin // 400-as válasznál is exception-re ugrik. Attól még a JSON válasz ott van a Stream-ben! hiba := E.Message; if SslHttpCli.StatusCode <> 400 then ntLOG( '! HIBA a küldéskor. Vélhetően net-hiba: ' + CRLF + hiba, 1 ); end; end; finally Result := (SslHttpCli.StatusCode = 200) or (SslHttpCli.StatusCode = 400); // goverment is sending error messages if = 400 try if SslHttpCli.RcvdStream.Size > 0 then begin SslHttpCli.RcvdStream.Seek(0, soFromBeginning); SetLength(JsonUTF8, SslHttpCli.RcvdStream.Size); SslHttpCli.RcvdStream.Read(JsonUTF8[1], SslHttpCli.RcvdStream.Size); valasz := UTF8Decode( JsonUTF8 ); ntLOG( 'Answer:' + CRLF + valasz + CRLF + 'Header:' + SslHttpCli.RcvdHeader.Text, -1 ); end else hiba := 'ERROR! 0 byte answer.'; except on E: Exception do hiba := ifThen(hiba<>'', hiba + CRLF) + 'Stream error: ' + CRLF + E.Message; end; SslHttpCli.SslContext := nil; try if Assigned(SslHttpCli.SendStream) then SslHttpCli.SendStream.Free; if Assigned(SslHttpCli.RcvdStream) then SslHttpCli.RcvdStream.Free; if Assigned(SslContext) then SslContext.Free; if Assigned(SslHttpCli) then SslHttpCli.Free; except end; end; end;

Thank you for all the answers so far! I'm using latest FastMM4 memory manager. (declared at the top of the project.) If I close the project, it is listing the "non-released resources" pretty well. There are basically none! I'm starting every necessary thread at program start, and stopping at the end. Each one is running a simple: While true do begin try ... except on e: Exception do LogMyError(...); end; // free all resources end; So there is no "recreating" problem at all. Also I've bought MadExcept module, so I get great error-debug reports from everywhere. Like: allocated memory : 150,98 MB largest free block : 6,05 MB exception number : 1 exception class : EOutOfResources ... main thread ($d7c): 0049126f +077 TermiPRO.exe Graphics GDIError 004912a7 +007 TermiPRO.exe Graphics GDICheck 0049545a +2d2 TermiPRO.exe Graphics CopyBitmap 00495c5b +063 TermiPRO.exe Graphics TBitmap.CopyImage 00497010 +03c TermiPRO.exe Graphics TBitmap.SetHeight 0063be2b +103 TermiPRO.exe acSBUtils 1629 +20 PrepareCache I've tested to recreate such errors: by changing AlphaSkin's acSBUtils.pas to set a TBitmap.Width. Found out, it is normally impossible, except a value over 600000 (x 1000 height). My EXE is running on all kinds of platforms everywhere: XP + Win7/10/11 32+64bit. Different brands Dell / HP / unique / etc ... all different CPUs ... different VGAs. Luckily nobody is using Win2000 any more. (I had 1 client still had 1 client PC just 4 years ago! 😄 ) This new problem occurs on all platforms similar way.

The new TThread is doing nothing special, just reading max first 64 lines from the firebird database via fresh created TUIBDatabase + TUIBQuery, creating a JSON from it, and sending to the government server, via special formed, (non standard JOSE signed) https REST PUT. The only interaction with main-thread is a thread-safe array record for logging and a few Booleans. (I've used the same logging array class for other threads before, without any problem.) Using latest Version: 8.70 (2022-11-09)

Probably this is a very basic question, but I simply can not find any working method... I'd like to change properties of many wincontrols, but only if necessary. Reason: I'm using special skinned components (AlphaSkin) and they call unnecessary repaint events. The trivial "solution" is to write code 2x: if myForm.Left <> calculateMySpecialValue(...) then myForm.Left := calculateMySpecialValue(...); But I'd like to have a universal procedure I can apply to everything! (TFont.Size, Grid1.Column.Width , etc.) I've tried this: procedure WR( i: PInteger; const new: integer ); begin if i^ <> new then i^ := new; end; But it does not compile with Delphi7 on many places. WR( @grid1.Columns[i].Width, trunc(grid1.Columns[i].Width * scale)-1); // ERROR: Variable required WR( PInteger(Addr(grid1.TitleFont.Size)), rFmv); // ERROR: Variable required

OK, so it's not so simple, as I've hoped 😞 If I understand it right, I will need : GetPropValue() and SetPropValue() functions or rather: GetInt64Prop() ? interesting is I could not find any GetInt32Prop() nor GetIntProp() ... .. and I will need to call it somehow with : WR( o: object; const name: string; const v: integer ) WR( grid1.columns[i], 'Width', 66 ); right ?

Hi, 😉 How to get SSL CERTIFICATE expiring date using OpenSSL3 ? SslHttpCli := TSslHttpCli.Create(nil); SslContext := TSslContext.Create(nil); SslContext.SslCertLines.Text := cer1; // cer1 is an ansiString ' --- BEGIN CER... ' endOfLife := // ?

Thank you very much for the detailed answer! The final code is: uses OverbyteIcsWSocket, OverbyteIcsSSLEAY; ... function get_certificate_expire_date(cerText: string):TDateTime; var X509 : TX509Base ; err : string; begin Result := 0; OverbyteIcsSSLEAY.GSSL_DLL_DIR := SS3_path; // if you store the OpenSSL DLL-s somewhere elsewhere X509 := TX509Base.Create(nil); X509.LoadFromTextEx( cerText, croNo, croTry, '', err ); if err = '' then Result := X509.ValidNotAfter // TDateTime else myLOG( 'Error during getting CER expire:' + CRLF + err ); X509.Free; end;

hmmm.... I was happy too soon. These are the results: ValidNotAfter = -657434 ValidNotBefore = 2958466 isCertLoaded = False Don't I need to call a procedure for "digesting", before getting these values?

Thank you very much, I did it similarly too 😉

Succeeded 🙂 var R : TRect; ... function GetY(const TXT: string): integer; begin Windows.DrawTextEx( lbl_1.Canvas.Handle, PAnsiChar( TXT ), Length( TXT ), R, DT_TOP or DT_RIGHT or DT_CALCRECT, nil ); Result := R.Bottom; end; begin ... R := Rect (0,0, 500, 300); y_ALL := GetY(myText); ... That was the key.

Thanks, I'll look into it. Seems promising. 🙂 I guess I'll also need: DT_WORDBREAK or DT_TOP or DT_LEFT. Anything else?

The only question remains about a self-created ShowMessage dialog: How to determine optimally the necessary wide / height for the text. 1. Normally I like small boxes at the middle of the screen, 2. but would like to make it "screen-wide" if the text is longer. 3. and even Full-Screen sized, if the text is toooooo long. I've thought about "checking 3x", if it fits, but can not determine the current Height, because the TextHeight function does not properly working under Delphi 7. Label1.Width := 400; Label1.Font.Size := 14; Label1.WordWrap = True; // Label1 is a "sLabel" of AlphaSkin component pack, if that counts? y_1 := Label1.Canvas.TextHeight('Ág'); // y_1 = 13 txt := 'first line' + #13#10 + #13#10 + #13#10 + #13#10 + #13#10 + 'other very long line to force a word wrap occure... 1234567890'; y_All := Label1.Canvas.TextHeight(txt); // does not give back correct word-wrapped info! :-( // y_All = 47; = 3 lines only, instead of more. linesNum := y_All div y_1; Any ideas? (Checked 50 forums, but did not find any answer.)

OFF: Thank you very much to all of you! I'll take the advice of @programmerdelphi2k : @Fr0sT.Brutal : That "hook" code is great, 🙂 although a bit complicated for me, without "how to use it" example. Thank you very much! But I'm still using Delphi7 and the code is only for 2009+. Also have a "keyboard hook" in my code, and it's always leaking, when I close the program, so I rather stay away from that technic. For "easy replacing" : I have GExpert installed. It is easy to click "Grep Search" and than > replace. I'm just afraid of forgetting next time: NOT to use ShowMessage function any more... (25+ years of daily practice is hard to replace 😄 )

How do I do that?

As suggested by everyone else: - I've just created my own custom dialog Form too. But how do I override automatically every ShowMessage('...') funtion in my program globally? - I do not want to replace the word "ShowMessage" in all 900+ places, because maybe next time I will forget to type my own function name. (Also Delphi is auto-replacing to that if is type: "smg"). - Also do not want to put a new unit to all 110+ PAS files one by one. I'd also like to override InputBox later with similar method. Thanks for any help!

I have the same problem too. As it turned out, it is caused by a 3th party component, that is "overriding" all forms. For me it was the "skinning all form" component called: sSkinManager created by: AlphaSkins Had to turn OFF automatic skinning rules by setting at Design time: SkinManager1.SkinningRules := []; But I'm not sure if that's fixing it properly. I've also just created my own custom ShowMessage dialog form, ... but yet looking for a way to override all "ShowMessage(...)" function everywhere in my program.

Hi, An hour ago I've tried out CnPack's "Bug reporter" IDE enhancement. It did not go well, after I've clicked "send Email". (Lot's of AV errors, ca 100 / sec while tried to close Delphi 7.) Since than: If I click the green |> arrow or [F9] to start debugging >> it compiles the EXE fine, than starts the EXE normally! (without attaching the debugger process.) Tried to: - restart PC - disable some CnPack modules But nothing helps 😞 - Where is the Delphi "error LOG file"?

FOUND the Solution ! ✔️ At Tool menu > Debugging options window > there is a checkbox at the bottom called: [ ] Integrated debugging which was turned OFF ! ( I didn't touch it, I swear! So it must have been CnPack somehow.) Checking it (ON) solved it.

I'm trying to create a FastReport Preview that's easier to handle for the user. (Bigger Close button, special page-zoom, etc.) But I'm a bit confused. Never saw a component that's inherited from TForm but hiding all it's basic functions like: .close(); If I try to create it runtime, and place it on my existing form, (inside a panel), how do I CLOSE it from my code ? Also would like to: disable the right-click popup remove the "FastReport - ..." word from the printing title inside the print jobs I've looked at the source code hours long, tried many things, but it ends usually by Access Violation error. The only thing I was able to find out/fix is: to set MyReport.Preview := nil; after usage, so it does not create error. So how do I close + free a preview (after showed or printed) without destroying the original component, that is paced on the form? Thanks for any help / tip in forward 😉

Thanks, but FreeReport does not have that property. 😞 I guess I have to change the source code of FreeReport to be able to handle that.

I'm still struggling: How to scroll UP and DOWN a little? (Not a whole page.) I do not want to add any Focus on that Preview and wanna hide the default scrollbars too. The problem is, that the component is hiding the .FWindow property as it is private. So I can not send any FormKeyDown() event, nor can I reach it's VScrollbar object. VScrollBar.Position := VScrollBar.Position - VScrollBar.SmallChange // not reachable MyFastPreview.ScrollBy( 0, -100 ); // does nothing, just flickers the screen for a moment Any tips how to solve this?

That was the problem. I've forgot to set that to nil too.

Thank you VERY VERY MUCH ! 🙂 With the help of your example-code, I was able to finish it this way.

@Zoran @programmer You both misunderstood my question. I know about the basics. I know about all those links. Those do not help. I can create reports. (Using them since 20 years.) - But how do I close it safely via code? (For example with a timer.) ONLY the report-preview, not the whole form it's placed on !

I've just realized that my code is not good enough, because it contains 3 digits after the second part, not just 2, as RFC3339 specifies. function ftdt_ISO(const dt: TDateTime; RFC3339: Boolean = False): string; // ISO8601 formátum: "2022-04-19T11:30:26.090+02:00" RFC3339 formátum: "2022-04-19T11:30:26.09+02:00" const RFCDateLongTimeMask = 'yyyy-mm-dd"T"hh:nn:ss.zz' ; ISODateLongTimeMask = RFCDateLongTimeMask + 'z' ; var TZINFO : TTimeZoneInformation; _b : Double; begin case Windows.GetTimeZoneInformation(TZINFO) of TIME_ZONE_ID_STANDARD: _b := TZINFO.Bias / (60*24); TIME_ZONE_ID_DAYLIGHT: _b := (TZINFO.Bias+ TZINFO.DaylightBias) / (60*24); else _b := 0; end; Result := FormatDateTime( IfThen(RFC3339, RFCDateLongTimeMask, ISODateLongTimeMask), dt) + ifThen(_b <= 0, '+', '-') + FormatDateTime( 'hh:nn', _b) ; end; I'm using it this way: var o : ISuperObject; begin ... o := SO(); o.S['started'] := ftdt_ISO( myTime, True ); // result: 2022-11-19T18:18:18.123+01:00 instead of ..18.12+.. Is there a working way to do it under Delphi 7 ? Thanks for the help! 🙂