KodeZwerg

Good day, I would like to have ability in my project to show certificate details of signed executables. (From other executables) Is that possible with Delphi? Would love to get hints 'how-to'! //edit For now I have ability to get raw data thats appended to executables (overlay data) by simply check PE header for filesize and compare with real physical filesize.

There are many possibilities that could "lock" a file. - a file is currently accessed - a filehandle with non-share rights is created - a region lock is set - a system driver prevent access - account deny access For all counts the same rule, blast the "lock" away could have more consequences than imaginable at that moment ps: for me https://lockhunter.com/ was always doing the job in a way that I like but using I do that tool like .... once in a leap year?

If the requirements of a software not fit, what do you expect to get? At least for your Matlab you can use the online version on whatever device.

I have a problem with Delphi Alexandria and it's JSON methods, maybe I just do it wrong and would like to get help. Here is my demo project that show the problem. program Project12; {$APPTYPE CONSOLE} {$R *.res} uses Winapi.Windows, System.Classes, System.SysUtils, System.IOUtils, System.JSON; type TMyJsonRec = packed record MyInteger: Integer; MyInt64: Int64; MyUInt64: UInt64; MyDWORD: DWORD; MyDouble: Double; MyBoolean: Boolean; MyString: string; end; procedure SaveJsonToFile(const AJsonObject: TJSONObject; const AFileName: string); var JsonText: string; StreamWriter: TStreamWriter; begin JsonText := AJsonObject.ToString; // is this the problematic part? StreamWriter := TStreamWriter.Create(AFileName, False, TEncoding.UTF8); try StreamWriter.Write(JsonText); finally StreamWriter.Free; end; end; procedure SaveRecordToJson(const ARecord: TMyJsonRec; const AFileName: string); var JsonObject: TJSONObject; begin JsonObject := TJSONObject.Create; try JsonObject.AddPair('MyInteger', TJSONNumber.Create(ARecord.MyInteger)); JsonObject.AddPair('MyInt64', TJSONNumber.Create(ARecord.MyInt64)); JsonObject.AddPair('MyUInt64', TJSONNumber.Create(ARecord.MyUInt64)); // this does not work as I would have thought it does, when it exceed Int64 range it break JsonObject.AddPair('MyDWORD', TJSONNumber.Create(ARecord.MyDWORD)); JsonObject.AddPair('MyDouble', TJSONNumber.Create(ARecord.MyDouble)); JsonObject.AddPair('MyBoolean', TJSONBool.Create(ARecord.MyBoolean)); JsonObject.AddPair('MyString', ARecord.MyString); SaveJsonToFile(JSonObject, AFileName); finally JsonObject.Free; end; end; function LoadRecordFromJson(const AFileName: string): TMyJsonRec; var JsonObject: TJSONObject; begin JsonObject := TJSONObject.ParseJSONValue(TFile.ReadAllText(AFileName)) as TJSONObject; try Result.MyInteger := JsonObject.GetValue('MyInteger').AsType<Integer>; Result.MyInt64 := JsonObject.GetValue('MyInt64').AsType<Int64>; Result.MyUInt64 := JsonObject.GetValue('MyUInt64').AsType<UInt64>; // this does not work as I would have thought it does, when it exceed Int64 range it break Result.MyDWORD := JsonObject.GetValue('MyDWORD').AsType<DWORD>; Result.MyDouble := JsonObject.GetValue('MyDouble').AsType<Double>; Result.MyBoolean := JsonObject.GetValue('MyBoolean').AsType<Boolean>; Result.MyString := JsonObject.GetValue('MyString').Value; finally JsonObject.Free; end; end; var MyRecord1, MyRecord2: TMyJsonRec; begin // Initialize the record MyRecord1.MyInteger := High(Integer); MyRecord1.MyInt64 := High(Int64); MyRecord1.MyUInt64 := High(UInt64); MyRecord1.MyDWORD := High(DWORD); MyRecord1.MyDouble := 123.456; MyRecord1.MyBoolean := True; MyRecord1.MyString := 'Hello, World!'; Writeln('Original record:'); Writeln('MyInteger: ', MyRecord1.MyInteger); Writeln('MyInt64: ', MyRecord1.MyInt64); Writeln('MyUInt64: ', MyRecord1.MyUInt64); Writeln('MyDWORD: ', MyRecord1.MyDWORD); Writeln('MyDouble: ', MyRecord1.MyDouble); Writeln('MyBoolean: ', MyRecord1.MyBoolean); Writeln('MyString: ', MyRecord1.MyString); SaveRecordToJson(MyRecord1, '.\test.json'); MyRecord2 := LoadRecordFromJson('.\test.json'); // Output the loaded record Writeln('Loaded record:'); Writeln('MyInteger: ', MyRecord2.MyInteger); Writeln('MyInt64: ', MyRecord2.MyInt64); Writeln('MyUInt64: ', MyRecord2.MyUInt64); Writeln('MyDWORD: ', MyRecord2.MyDWORD); Writeln('MyDouble: ', MyRecord2.MyDouble); Writeln('MyBoolean: ', MyRecord2.MyBoolean); Writeln('MyString: ', MyRecord2.MyString); ReadLn; end. I am unsure if it is the saving part or the reading part.

unit Unit12; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs; type TForm12 = class(TForm) procedure FormCreate(Sender: TObject); procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); private procedure DrawLine(Color : TColor); public FStartX, FStartY, FEndX, FEndY : integer; FLineDrawn : boolean; end; var Form12: TForm12; implementation {$R *.dfm} { TForm12 } procedure TForm12.FormCreate(Sender: TObject); begin FLineDrawn := False; end; procedure TForm12.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin FLineDrawn := True; FStartX := X; FStartY := Y; end; procedure TForm12.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin FEndX := X; FEndY := Y; if FLineDrawn then DrawLine(clRed); end; procedure TForm12.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin FLineDrawn := False; DrawLine(clGreen); end; procedure TForm12.DrawLine(Color : TColor); begin Self.Refresh; Canvas.Pen.Color := Color; Canvas.MoveTo(FStartX, FStartY); Canvas.LineTo(FEndX, FEndY); end; end. A very basic example that might lead you into the direction you want. Steps to reproduce: 1. Create a new Vcl Application. 2. Add handlers as shown in above example. 3. run app and press mouse button, keep it pressed while moving, release button for a final drawing.

Thank you @Attila Kovacs, I will try it with string conversation! Thank you @Uwe Raabefor confirming and suggestion me to create RSP-42079. I hope I did fill out the form there correct.

Does that mean I can not use UInt64 type in combination with JSON via Delphi's built-in JSON units?

To correct you, your topic is "bitmap not displayed", very informative but anyway I've read, later we found out that you try to code in a non-Vcl style by doing many things wrong. So Remy and I spend our time to write you an example. While you say that you can not compile for whatever reason Remy's code you said nothing to mine. Anders was correcting mine so it will do what your initial problem was, it display a bitmap. (even without fixing it does work...) Why you insist to still use your wrong way of doing? Why you never use the </> button to put your code better readable in? Why am I replying to this topic anymore? Best of luck!

I do more wonder why he not uses the example from @Remy Lebeau or the thing that I posted and close this topic/thread as solved.

Really? You thinking this is how GUI Applications made for Windows are internal working?

I can not answer if it is implemented in your Delphi 7 installation, maybe upgrade to a more common Delphi Community Edition can help. uses ...TypInfo, Rtti... function SetProperty(const AControl: TControl; const AProperty: string; const AValue: TValue): Boolean; var LControl: TControl; LRttiContext: TRttiContext; LRttiProperty: TRttiProperty; begin Result := False; try LControl := AControl; LRttiProperty := LRttiContext.GetType(LControl.ClassType).GetProperty(AProperty); if ((LRttiProperty <> nil) and (LRttiProperty.Visibility in [mvPrivate, mvProtected, mvPublic, mvPublished])) then begin LRttiProperty.SetValue(LControl, AValue); Result := True; end; except end; end; Call that method by giving a control as argument 1, write the property as it is named for argument 2 and finally as argument 3 put your wanted value in. Best of luck.

You can use the Nexus Quality Suite (MethodTimer) or a similar product to measure times of things that happen in code and how long they need to find bottlenecks.

A mini small correction; pe.dwSize := SizeOf(pe);

Is this not just for the purpose that at generation it will not get focus? I mean, the generated form can still be clicked and it get focus, or?

You can do this to prevent that the second form get a focus: ... protected procedure ActiveFormChanged(Sender: TObject); ... procedure TForm1.ActiveFormChanged(Sender: TObject); begin if not (csDestroying in ComponentState) then if ActiveControl <> nil then ActiveControl.SetFocus end; procedure TForm1.FormCreate(Sender: TObject); begin Screen.OnActiveFormChange := ActiveFormChanged; end;

How about - Design a form - make it borderless - put a Panel on (alClient) - put a Timer on - create OnShow event to activate timer - in Timer event simple call "Close" from your calling Form - create an event that does - "Form.Panel.Caption := 'My Text';" - "Form.Timer.Interval := 1234;" - "Form.Show;" In theory it does what you wanted, adjust what I forgot to mention.

Hey @Remy Lebeau, thank you so much for clarification, very appreciated the second code!

function GetParentProcessID(const AProcessID: DWORD): DWORD; var aProcesses: array[0..1023] of DWORD; cbNeeded, cProcesses, i: DWORD; hProcess: THandle; parentProcessID: DWORD; begin Result := 0; // Get the list of process identifiers if not EnumProcesses(@aProcesses[0], SizeOf(aProcesses), cbNeeded) then Exit; // Calculate how many process identifiers were returned cProcesses := cbNeeded div SizeOf(DWORD); // Find the process with the given process ID and get its parent process ID for i := 0 to cProcesses - 1 do begin if aProcesses[i] = AProcessID then begin hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, AProcessID); if hProcess <> 0 then begin try if GetProcessId(hProcess) <> 0 then parentProcessID := GetProcessId(hProcess); finally CloseHandle(hProcess); end; end; Break; end; end; Result := parentProcessID; end; Heres a faster way to get Parent ProcessID.

This method is not made to be run more than once. Thats why I wrote, at startup to choose what to do after check.

Why not simple use a mutex and check at startup for its presence? No need to do all that what @programmerdelphi2k wrote at all. @programmerdelphi2k I suggest to switch to EnumProcesses(), it is way faster compared to CreateToolhelp32Snapshot(). Here's a small snippet example that you could run at startup function AppStartedByItself: Boolean; var dummy: THandle; FSA: SECURITY_ATTRIBUTES; FSD: SECURITY_DESCRIPTOR; begin InitializeSecurityDescriptor(@FSD, SECURITY_DESCRIPTOR_REVISION); SetSecurityDescriptorDacl(@FSD, True, nil, False); FSA.lpSecurityDescriptor := @FSD; FSA.nLength := SizeOf(SECURITY_ATTRIBUTES); FSA.bInheritHandle := True; dummy := CreateMutexW(@FSA, True, PWideChar('Global\' + 'SomethingUnique')); Result := (GetLastError = ERROR_ALREADY_EXISTS); end; call this method and react on True (app was started by itself) or False (app was started not by itself) //updated the result setting

Make your app the OOP way and event driven, split your source into smaller parts, start your selfmade sleep and fire at sync an event that executes next things...

A little offtopic but might be also useful is https://wakatime.com/delphi what enables measuring of you coding 🙂

https://support.microsoft.com/en-us/windows/windows-7-support-ended-on-january-14-2020-b75d4580-2cc7-895a-2c9c-1466d9a53962 It will also not work in Windows XP or Windows 95.

I am sorry, here is a fixed version that also react for leap years... function CountSundays(const AStartDate, AEndDate: TDateTime): Integer; function MonthOf(const AValue: TDateTime): Word; var Year, Month, Day: Word; begin DecodeDate(AValue, Year, Month, Day); Result := Month; end; function YearOf(const AValue: TDateTime): Word; var Year, Month, Day: Word; begin DecodeDate(AValue, Year, Month, Day); Result := Year; end; function DayOf(const AValue: TDateTime): Word; var Year, Month, Day: Word; begin DecodeDate(AValue, Year, Month, Day); Result := Day; end; var LCurrentDate: TDateTime; LDirection: Integer; LDaysInMonth: array[1..12] of Integer = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31); begin Result := 0; if AStartDate > AEndDate then LDirection := -1 // Search for Sundays in reverse order else LDirection := 1; // Search for Sundays in forward order LCurrentDate := AStartDate; while DayOfWeek(LCurrentDate) <> 1 do // Find the first Sunday LCurrentDate := LCurrentDate + LDirection; if (LDirection = 1) and (LCurrentDate = AEndDate) then Inc(Result) // Add 1 if the end date is a Sunday else if (LDirection = -1) and (LCurrentDate = AEndDate) and (DayOfWeek(AStartDate) = 1) then Inc(Result) // Add 1 if the start and end dates are the same and represent a Sunday else begin while (AStartDate < AEndDate) and (LCurrentDate <= AEndDate) or (AStartDate > AEndDate) and (LCurrentDate >= AEndDate) do begin Inc(Result); LCurrentDate := LCurrentDate + (7 * LDirection); // Increment to next Sunday if MonthOf(LCurrentDate) = 2 then // Adjust for leap year begin if IsLeapYear(YearOf(LCurrentDate)) then LDaysInMonth[2] := 29 else LDaysInMonth[2] := 28; end; if DayOf(LCurrentDate) > LDaysInMonth[MonthOf(LCurrentDate)] then // Adjust for end of month LCurrentDate := EncodeDate(YearOf(LCurrentDate), MonthOf(LCurrentDate) + 1, 1) - 1; end; end; end;

How about: function CountSundays(const AStartDate, AEndDate: TDateTime): Integer; var LCurrentDate: TDateTime; LDirection: Integer; begin Result := 0; if AStartDate > AEndDate then LDirection := -1 // Search for Sundays in reverse order else LDirection := 1; // Search for Sundays in forward order LCurrentDate := AStartDate; while DayOfWeek(LCurrentDate) <> 1 do // Find the first Sunday LCurrentDate := LCurrentDate + LDirection; while (AStartDate < AEndDate) and (LCurrentDate <= AEndDate) or (AStartDate > AEndDate) and (LCurrentDate >= AEndDate) do begin Inc(Result); LCurrentDate := LCurrentDate + (7 * LDirection); // Jump to next/prior Sunday end; end; That approach works in both directions (ie: it does not matter what the start- and end- date is)