osapiutils

1
unit OSAPIUtils;
2

3
{  Author: Pichugin Maksim }
4

5
{2024-09-22}
6
{2024-06-04}
7
{2024-02-04}
8
{2024-01-03}
9
{2023-11-22}
10
{2023-10-28}
11
{2023-10-23}
12
{2023-10-05}
13
{2023-05-11}
14
{2023-04-29}
15
{2023-03-19}
16
{2023-03-14}
17
{2023-01-21}
18

19
{$mode objfpc}{$H+}
20

21
interface
22

23
uses
24
  {$IFDEF WINDOWS}
25
      Windows, StdCtrls, ExtCtrls, Graphics,
26
  {$ENDIF}
27
  {$IFDEF UNIX}
28
      unix,baseunix,users,
29
  {$ENDIF}
30
   WinSock, JWAWindows,
31
   Registry, Forms, Classes, SysUtils, Dialogs, Controls, Buttons, Menus,
32
   LazUTF8, FileUtil, LazFileUtils;
33

34
type
35
  TEXEVersionData = record
36
    CompanyName,
37
    FileDescription,
38
    FileVersion,
39
    InternalName,
40
    LegalCopyright,
41
    LegalTrademarks,
42
    OriginalFileName,
43
    ProductName,
44
    ProductVersion,
45
    Comments,
46
    PrivateBuild,
47
    SpecialBuild: string;
48
  end;
49

50
  //Active Directory User Data
51
  TADUserData = record
52
    ADUser                           :Boolean;
53
    // Fully qualified distinguished name
54
    NameFullyQualifiedDN             :ShortString;
55
    // Windows NT® 4.0 account name
56
    NameSamCompatible                :ShortString;
57
    // A "friendly" display name
58
    NameDisplay                      :ShortString;
59
    // GUID string that the IIDFromString function returns
60
    NameUniqueId                     :ShortString;
61
    // Complete canonical name
62
    NameCanonical                    :ShortString;
63
    // User principal name
64
    NameUserPrincipal                :ShortString;
65

66
    NameCanonicalEx                  :ShortString;
67
    // Generalized service principal name
68
    NameServicePrincipal             :ShortString;
69
    // DNS domain name, plus the user name
70
    DNSDomainName                    :ShortString;
71
    // The DNS domain name followed by a backward-slash and the SAM user name.
72
    NameDnsDomain                    :ShortString;
73
    // The first name or given name of the user.
74
    NameGivenName                    :ShortString;
75
    // The last name or surname of the user.
76
    NameSurname                      :ShortString;
77
  end;
78

79
  {
80

81
  }
82

83
  { TNMDialogFormActions }
84

85
  TNMDialogFormActions = class
86
  private
87
    { Private declarations }
88
  public
89
    procedure ButtonClose(Sender: TObject);
90
    procedure FormClose(Sender: TObject;  var CloseAction: TCloseAction);
91
  end;
92

93
  {$IFDEF MSWINDOWS}
94
  const
95
    {$EXTERNALSYM IDI_HAND}
96
    IDI_HAND        = MakeIntResource(OIC_HAND);
97
    {$EXTERNALSYM IDI_QUESTION}
98
    IDI_QUESTION    = MakeIntResource(OIC_QUES);
99
    {$EXTERNALSYM IDI_EXCLAMATION}
100
    IDI_EXCLAMATION  = MakeIntResource(OIC_WARNING);
101
    {$EXTERNALSYM IDI_ASTERISK}
102
    IDI_ASTERISK     = MakeIntResource(OIC_INFORMATION);
103
    {$EXTERNALSYM IDI_WINLOGO}
104
    IDI_WINLOGO      = MakeIntResource(OIC_WINLOGO);
105
    {$EXTERNALSYM IDI_WARNING}
106
    IDI_WARNING      = IDI_EXCLAMATION;
107
    {$EXTERNALSYM IDI_ERROR}
108
    IDI_ERROR        = IDI_HAND;
109
    {$EXTERNALSYM IDI_INFORMATION}
110
    IDI_INFORMATION  = IDI_ASTERISK;
111
    {$EXTERNALSYM IDI_SHIELD}
112
    IDI_SHIELD       = MakeIntResource(OIC_SHIELD);
113

114
  {$ENDIF MSWINDOWS}
115

116
var
117
   SYSTEM_PATHVARS_INITED          :Boolean=False; //OSGlobalPathVarInited
118
   SYSTEM_PATHVARS                 :TStringList;
119
   NMDialogFormActions             :TNMDialogFormActions;
120

121
   {
122
     ===Windows vars===
123

124
     %SystemDrive%
125

126
     CURRENT_USER
127

128
       %APPDATA%
129
       %LOCALAPPDATA%
130
       %USERDOMAIN%
131
       %USERNAME%
132
       %USERPROFILE%
133
       %HOMEDRIVE%
134

135
       %TEMP%
136
       %TMP%
137

138
       %USERLOCALLOW%
139
       %USERDOWNLOADS%
140

141
     LOCAL_MACHINE
142

143
       %ProgramData%
144
       %ProfilesDirectory%
145
       %Default%
146
       %Public%
147

148
     ===Extended vars====
149

150
     Firebird DB
151

152
       %FirebirdProgramDirectory%
153
   }
154

155
{FILES}
156

157
function GetAbsolutSystemPath(var APath:String):Boolean;
158
//Установка текущей директорией место размещения программы
159
function ChangeCurrentDirectory: boolean;
160

161
function PathExists(APath:String; ACreate:Boolean):boolean;
162

163
{NETWORK}
164

165
function GetLocalIP: string;
166
function GetLocalHostname: string;
167

168
{OTHER}
169

170
function GetGUID: String;
171
function GetCurrentUserName : String;
172
function GetCurrentComputerName : String;
173
function GetADUserData(var AOutData:TADUserData):Boolean;
174

175
{APP}
176

177
function StartApp(AFileName, AParams:String): Integer;
178
function GetEXEVersionData(const FileName: string; var OutData:TEXEVersionData): Boolean;
179

180
{DIALOGS}
181

182
function ShowTaskDialog(AOwner:TComponent; AMsg: String; AMsgBoxFlags: Longint=MB_ICONINFORMATION):integer; overload;
183
function ShowTaskDialog(AOwner:TComponent; AMsg: String; AWarningHint:String=''; AMsgBoxFlags: Longint=MB_ICONINFORMATION):integer; overload;
184
procedure ShowTaskDialogNM(AMsg: String; AMsgBoxFlags: Longint=MB_ICONINFORMATION); overload;
185
procedure ShowTaskDialogNM(AMsg: String; AWarningHint:String=''; AMsgBoxFlags: Longint=MB_ICONINFORMATION); overload;
186

187
implementation
188

189
procedure ShowTaskDialogNM(AMsg: String; AMsgBoxFlags: Longint=MB_ICONINFORMATION);
190
begin
191
    ShowTaskDialogNM(AMsg, '', AMsgBoxFlags);
192
end;
193

194
procedure ShowTaskDialogNM(AMsg: String; AWarningHint:String=''; AMsgBoxFlags: Longint=MB_ICONINFORMATION);
195
var
196
    IconHandle       :HICON;
197
    WarnIconHandle   :HICON;
198
    DForm            :TForm;
199
    DPanelBottom     :TPanel;
200
    DPanelWarningBottom :TPanel;
201
    DPanelMain          :TPanel;
202
    DPanelMLeft         :TPanel;
203
    WarnIconImage,
204
    IconImage           :TImage;
205
    Button              :TButton;
206
    MessageWarningText  :TLabel;
207
    MessageText         :TLabel;
208
begin
209
    {$IFDEF MSWINDOWS}
210
    if IDI_WARNING<>nil then
211
      WarnIconHandle := LoadIcon(0,IDI_WARNING)
212
    else
213
      WarnIconHandle := 0;
214
    {$ELSE}
215
    WarnIconHandle := 0;
216
    {$ENDIF}
217

218
    case AMsgBoxFlags of
219
     MB_ICONINFORMATION:
220
     begin
221
        {$IFDEF MSWINDOWS}
222
        if IDI_INFORMATION<>nil then
223
          IconHandle := LoadIcon(0,IDI_INFORMATION)
224
        else
225
          IconHandle := 0;
226
        {$ELSE}
227
        IconHandle := 0;
228
        {$ENDIF}
229
     end;
230
     MB_ICONEXCLAMATION:
231
     begin
232
        {$IFDEF MSWINDOWS}
233
        if IDI_EXCLAMATION<>nil then
234
          IconHandle := LoadIcon(0,IDI_EXCLAMATION)
235
        else
236
          IconHandle := 0;
237
        {$ELSE}
238
        IconHandle := 0;
239
        {$ENDIF}
240
     end;
241
     MB_ICONERROR:
242
     begin
243
        {$IFDEF MSWINDOWS}
244
        if IDI_ERROR<>nil then
245
          IconHandle := LoadIcon(0,IDI_ERROR)
246
        else
247
          IconHandle := 0;
248
        {$ELSE}
249
        IconHandle := 0;
250
        {$ENDIF}
251
     end;
252
    end;
253

254
    if (Length(AMsg)>0) then
255
    begin
256
        DForm:=TForm.Create(Application);
257
        DForm.Caption:=Application.Title;
258
        //DForm.ParentWindow:=GetDesktopwindow;
259
        DForm.Width:=400;
260
        DForm.Height:=150;
261
        DForm.BorderStyle:=bsDialog;
262
        DForm.Position:=poWorkAreaCenter;//
263
        DForm.OnClose:=Addr(NMDialogFormActions.FormClose);
264
        DForm.ShowInTaskBar:=stAlways;
265
        DForm.FormStyle:=fsStayOnTop;
266
        //Bottoom
267

268
        if Length(AWarningHint)>0 then
269
        begin
270
        DPanelWarningBottom:=TPanel.Create(DForm);
271
        DPanelWarningBottom.Parent:=DForm;
272
        DPanelWarningBottom.Align:=alBottom;
273
        DPanelWarningBottom.Height:=32;
274
        DPanelWarningBottom.BevelOuter:=bvNone;
275
        DPanelWarningBottom.Show;
276

277
        WarnIconImage:=TImage.Create(DPanelWarningBottom);
278
        WarnIconImage.Parent:=DPanelWarningBottom;
279
        WarnIconImage.Align:=alLeft;
280
        WarnIconImage.AutoSize:=True;
281
        WarnIconImage.Width:=48;
282
        WarnIconImage.Center:=True;
283
        WarnIconImage.Transparent:=True;
284
        WarnIconImage.Proportional:=True;
285
        WarnIconImage.Stretch:=True;
286
        WarnIconImage.BorderSpacing.Top:=5;
287
        WarnIconImage.BorderSpacing.Left:=5;
288
        WarnIconImage.BorderSpacing.Bottom:=5;
289
        WarnIconImage.BorderSpacing.Right:=5;
290
        WarnIconImage.Picture.Icon.Handle:=WarnIconHandle;
291

292
        MessageWarningText:=TLabel.Create(DPanelWarningBottom);
293
        MessageWarningText.Parent:=DPanelWarningBottom;
294
        MessageWarningText.Caption:=AWarningHint;
295
        MessageWarningText.Align:=alClient;
296
        MessageWarningText.Alignment:=taLeftJustify;
297
        MessageWarningText.Layout:=tlCenter;
298
        MessageWarningText.Transparent:=True;
299
        MessageWarningText.WordWrap:=True;
300
        MessageWarningText.BorderSpacing.Top:=5;
301
        MessageWarningText.BorderSpacing.Left:=5;
302
        MessageWarningText.BorderSpacing.Bottom:=5;
303
        MessageWarningText.BorderSpacing.Right:=5;
304
        MessageWarningText.Show;
305
        end;
306

307
        DPanelBottom:=TPanel.Create(DForm);
308
        DPanelBottom.Parent:=DForm;
309
        DPanelBottom.Align:=alBottom;
310
        DPanelBottom.Height:=46;
311
        DPanelBottom.BevelOuter:=bvNone;
312
        DPanelBottom.Show;
313

314
        //Center
315
        DPanelMain:=TPanel.Create(DForm);
316
        DPanelMain.Parent:=DForm;
317
        DPanelMain.Align:=alClient;
318
        DPanelMain.BevelOuter:=bvNone;
319
        DPanelMain.Color:=clWindow;
320
        DPanelMain.Show;
321

322
        DPanelMLeft:=TPanel.Create(DPanelMain);
323
        DPanelMLeft.Parent:=DPanelMain;
324
        DPanelMLeft.Align:=alLeft;
325
        DPanelMLeft.Width:=64;
326
        DPanelMLeft.BevelOuter:=bvNone;
327
        DPanelMLeft.Color:=clWindow;
328
        DPanelMLeft.Show;
329

330
        IconImage:=TImage.Create(DPanelMLeft);
331
        IconImage.Parent:=DPanelMLeft;
332
        IconImage.Align:=alTop;
333
        IconImage.AutoSize:=True;
334
        IconImage.Height:=64;
335
        IconImage.Center:=True;
336
        IconImage.Transparent:=True;
337
        IconImage.Proportional:=True;
338
        IconImage.BorderSpacing.Top:=5;
339
        IconImage.BorderSpacing.Left:=5;
340
        IconImage.BorderSpacing.Bottom:=5;
341
        IconImage.BorderSpacing.Right:=5;
342
        IconImage.Picture.Icon.Handle:=IconHandle;
343

344
        Button:=TButton.Create(DPanelBottom);
345
        Button.Parent:=DPanelBottom;
346
        Button.Caption:='OK';
347
        Button.Cancel:=True;
348
        Button.Height:=24;
349
        Button.Width:=100;
350
        Button.Align:=alRight;
351
        Button.BorderSpacing.Top:=10;
352
        Button.BorderSpacing.Left:=10;
353
        Button.BorderSpacing.Bottom:=10;
354
        Button.BorderSpacing.Right:=10;
355
        Button.ModalResult:=mrClose;
356
        Button.OnClick:=Addr(NMDialogFormActions.ButtonClose);
357
        Button.Show;
358

359
        MessageText:=TLabel.Create(DPanelMain);
360
        MessageText.Parent:=DPanelMain;
361
        MessageText.Caption:=AMsg;
362
        MessageText.Align:=alClient;
363
        MessageText.Transparent:=True;
364
        MessageText.WordWrap:=True;
365
        MessageText.BorderSpacing.Top:=10;
366
        MessageText.BorderSpacing.Left:=10;
367
        MessageText.BorderSpacing.Bottom:=10;
368
        MessageText.BorderSpacing.Right:=10;
369
        MessageText.Show;
370

371
        if Length(AWarningHint)>0 then
372
        begin
373
           DPanelWarningBottom.Top:=DForm.Height;
374
        end;
375

376
        DForm.Show;
377
    end;
378
end;
379

380
function ShowTaskDialog(AOwner:TComponent; AMsg: String; AMsgBoxFlags: Longint): integer;
381
begin
382
   Result:=ShowTaskDialog(AOwner, AMsg, '', AMsgBoxFlags);
383
end;
384

385
function ShowTaskDialog(AOwner:TComponent; AMsg: String; AWarningHint:String; AMsgBoxFlags: Longint):integer;
386
var
387
  ADialog:TTaskDialog;
388
begin
389
  Result   :=0;
390
  if (AMsgBoxFlags>-1)and(Length(AMsg)>0) then
391
  begin
392
     ADialog         :=TTaskDialog.Create(AOwner);
393
     ADialog.Caption :=Application.Title;
394
     ADialog.Text    :=AMsg;
395
     ADialog.Flags   :=[tfAllowDialogCancellation, tfPositionRelativeToWindow];
396

397
     if AWarningHint<>'' then
398
     begin
399
        ADialog.FooterIcon :=tdiWarning;
400
        ADialog.FooterText :=AWarningHint;
401
     end;
402

403
       if ((AMsgBoxFlags and MB_ICONEXCLAMATION)=MB_ICONEXCLAMATION)then
404
       begin
405
         ADialog.Title:='Уведомление';
406
         ADialog.CommonButtons := [];
407
         with TTaskDialogButtonItem(ADialog.Buttons.Add) do
408
         begin
409
            Caption := 'OK';
410
            ModalResult := mrOk;
411
         end;
412
         ADialog.MainIcon:=tdiWarning;
413
         if ADialog.Execute then
414
         begin
415
            Result:=ADialog.ModalResult;
416
         end;
417
       end
418
       else if (AMsgBoxFlags and MB_ICONQUESTION)=MB_ICONQUESTION then
419
       begin
420
         ADialog.Title:='Вопрос';
421
         ADialog.CommonButtons := [tcbYes, tcbNo];
422
         ADialog.MainIcon:=tdiQuestion;
423
         if ADialog.Execute then
424
         begin
425
            Result:=ADialog.ModalResult;
426
         end;
427
       end
428
       else if (AMsgBoxFlags and MB_ICONINFORMATION)=MB_ICONINFORMATION then
429
       begin
430
         ADialog.Title:='Информирование';
431
         ADialog.CommonButtons := [];
432
         with TTaskDialogButtonItem(ADialog.Buttons.Add) do
433
         begin
434
            Caption := 'OK';
435
            ModalResult := mrOk;
436
         end;
437
         ADialog.MainIcon:=tdiInformation;
438
         if ADialog.Execute then
439
         begin
440
            Result:=ADialog.ModalResult;
441
         end;
442
       end
443
       else if (AMsgBoxFlags and MB_ICONERROR)=MB_ICONERROR then
444
       begin
445
         ADialog.Title:='Исключение';
446
         ADialog.CommonButtons := [];
447
         with TTaskDialogButtonItem(ADialog.Buttons.Add) do
448
         begin
449
            Caption := 'OK';
450
            ModalResult := mrOk;
451
         end;
452
         ADialog.MainIcon:=tdiError;
453
         if ADialog.Execute then
454
         begin
455
            Result:=ADialog.ModalResult;
456
         end;
457
       end;
458
     ADialog.Free;
459
  end;
460
end;
461

462
function GetEnvVarValue(const VarName: string): string;
463
begin
464
  {$IFDEF WINDOWS}
465
      Result := GetEnvironmentVariable(VarName);
466
  {$ELSE}
467
      Result := '';
468
  {$ENDIF}
469
end;
470

471
function SetSystemPathParamsToVar:Boolean;
472
var
473
   reg         :TRegistry;
474
   sName,
475
   sPath       :String;
476
   i,i1,i2,
477
   iCountCicle :integer;
478
   Names:TStringList;
479
begin
480
  Result                :=False;
481
  SYSTEM_PATHVARS_INITED :=True;
482

483
  {$IFDEF WINDOWS}
484

485
      reg                := TRegistry.Create;
486
      reg.Access         := KEY_WOW64_64KEY or KEY_READ;
487
      Names              := TStringList.Create;
488
      try
489

490
          sPath:=GetEnvVarValue('SystemDrive');
491
          SYSTEM_PATHVARS.AddPair('%SystemDrive%', sPath);
492

493
          reg.RootKey     := HKEY_CURRENT_USER;
494

495
          if reg.OpenKeyReadOnly('Volatile Environment') then
496
          begin
497
            {
498
            reg.GetValueNames(Names);
499
            for i:=0 to Names.Count-1 do
500
            begin
501
               sName:=Names.Strings[i];
502
               SYSTEM_PATHVARS.AddPair('%'+sName+'%',reg.ReadString(sName));
503
            end;
504
            }
505
            SYSTEM_PATHVARS.AddPair('%APPDATA%',reg.ReadString('APPDATA')); // C:\Users\...\AppData\Roaming
506
            SYSTEM_PATHVARS.AddPair('%LOCALAPPDATA%',reg.ReadString('LOCALAPPDATA')); //C:\Users\...\AppData\Local
507
            SYSTEM_PATHVARS.AddPair('%USERDOMAIN%',reg.ReadString('USERDOMAIN'));
508
            SYSTEM_PATHVARS.AddPair('%USERNAME%',reg.ReadString('USERNAME'));
509
            SYSTEM_PATHVARS.AddPair('%USERPROFILE%',reg.ReadString('USERPROFILE'));
510
            SYSTEM_PATHVARS.AddPair('%HOMEDRIVE%',reg.ReadString('HOMEDRIVE'));
511

512
            reg.CloseKey;
513
          end
514
          else begin
515
             raise Exception.Create('Can`t read Windows registry "Volatile Environment" params');
516
          end;
517

518
          if reg.OpenKeyReadOnly('Environment') then
519
          begin
520

521
            SYSTEM_PATHVARS.AddPair('%TEMP%',reg.ReadString('TEMP'));
522
            SYSTEM_PATHVARS.AddPair('%TMP%',reg.ReadString('TMP'));
523

524
            reg.CloseKey;
525
          end
526
          else begin
527
             raise Exception.Create('Can`t read Windows registry "Environment" params');
528
          end;
529

530
          if reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders') then
531
          begin
532
            SYSTEM_PATHVARS.AddPair('%USERDOWNLOADS%',reg.ReadString('{374DE290-123F-4565-9164-39C4925E467B}'));
533
            SYSTEM_PATHVARS.AddPair('%USERLOCALLOW%',reg.ReadString('{A520A1A4-1780-4FF6-BD18-167343C5AF16}'));
534
            reg.CloseKey;
535
          end
536
          else begin
537
             raise Exception.Create('Can`t read Windows registry "Shell Folders" params');
538
          end;
539

540
          reg.RootKey     := HKEY_LOCAL_MACHINE;
541

542
          if reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList') then
543
          begin
544
            SYSTEM_PATHVARS.AddPair('%ProgramData%',reg.ReadString('ProgramData'));
545
            SYSTEM_PATHVARS.AddPair('%ProfilesDirectory%',reg.ReadString('ProfilesDirectory'));
546
            SYSTEM_PATHVARS.AddPair('%Default%',reg.ReadString('Default'));
547
            SYSTEM_PATHVARS.AddPair('%Public%',reg.ReadString('Public'));
548

549
            reg.CloseKey;
550
          end
551
          else begin
552
             //raise Exception.Create('Can`t read Windows registry "HKEY_LOCAL_MACHINE" params');
553
          end;
554

555
          {Firebird}
556
          {}
557
          if reg.KeyExists('SOFTWARE\Firebird Project\Firebird Server\Instances') then
558
          begin
559
            if reg.OpenKeyReadOnly('SOFTWARE\Firebird Project\Firebird Server\Instances') then
560
            begin
561
              SYSTEM_PATHVARS.AddPair('%FirebirdProgramDirectory%',reg.ReadString('DefaultInstance'));
562
              reg.CloseKey;
563
            end;
564
          end;
565

566
          for i1:=0 to SYSTEM_PATHVARS.Count-1 do
567
          begin
568
              if UTF8Pos('%',SYSTEM_PATHVARS.ValueFromIndex[i1])>0 then
569
              begin
570
                iCountCicle :=SYSTEM_PATHVARS.Count;
571
                sPath       :=SYSTEM_PATHVARS.ValueFromIndex[i1];
572
                while (iCountCicle>0) do
573
                begin
574

575
                  for i2:=0 to SYSTEM_PATHVARS.Count-1 do
576
                  begin
577
                      sPath:=UTF8StringReplace(sPath,SYSTEM_PATHVARS.Names[i2],SYSTEM_PATHVARS.ValueFromIndex[i2],[rfIgnoreCase]);
578
                  end;
579

580
                  dec(iCountCicle);
581
                end;
582
                SYSTEM_PATHVARS.ValueFromIndex[i1]:=sPath;
583
              end;
584
          end;
585

586
          Result:=True;
587
      finally
588
         Names.Free;
589
         reg.Free;
590
      end;
591

592
      //Или так
593
      //FUnpackPath:=WinCPToUTF8(GetEnvironmentVariable(TEMPFOLDERWINDOWS));   //без %%
594

595
  {$ELSE}
596
      //SYSTEM_PATHVARS.AddPair('%APPDATA%',reg.ReadString('APPDATA'));
597
      //SYSTEM_PATHVARS.AddPair('%LOCALAPPDATA%',reg.ReadString('LOCALAPPDATA'));
598
      //SYSTEM_PATHVARS.AddPair('%USERDOMAIN%',reg.ReadString('USERDOMAIN'));
599
      SYSTEM_PATHVARS.AddPair('%USERNAME%',GetUserName(fpgetuid));
600
      //SYSTEM_PATHVARS.AddPair('%USERPROFILE%',reg.ReadString('USERPROFILE'));
601
      //SYSTEM_PATHVARS.AddPair('%HOMEDRIVE%',reg.ReadString('HOMEDRIVE'));
602
      SYSTEM_PATHVARS.AddPair('%TEMP%',GetTempDir(False));
603
      SYSTEM_PATHVARS.AddPair('%TMP%',GetTempDir(False));
604
      Result:=False;
605
  {$ENDIF}
606

607
end;
608

609
function SetProgramPathToVar:Boolean;
610
var
611
  sPath       :String;
612
begin
613
  Result      :=False;
614

615
  {$IFDEF WINDOWS}
616

617
      try
618
          sPath:=ExtractFilePath(Paramstr(0));
619
          sPath:=SysUtils.IncludeTrailingPathDelimiter(sPath);
620
          SYSTEM_PATHVARS.AddPair('%ProgramPath%', sPath);
621

622
          Result:=True;
623
      finally
624

625
      end;
626

627
  {$ELSE}
628
      Result:=False;
629
  {$ENDIF}
630

631
end;
632

633
function GetAbsolutSystemPath(var APath:String):Boolean;
634
var
635
   iCountCicle, i :integer;
636
   sPath          :String;
637
begin
638
  Result :=False;
639

640
  {$IFDEF WINDOWS}
641

642
      if not SYSTEM_PATHVARS_INITED then
643
      begin
644
           if not SetSystemPathParamsToVar then
645
              Application.MessageBox(PChar('Не удалось получить параметры путей системы'), Pchar(Application.Title),MB_ICONERROR);
646
      end;
647

648
      if UTF8Pos('%',APath)>0 then
649
      begin
650
        iCountCicle :=SYSTEM_PATHVARS.Count;
651
        sPath       :=APath;
652
        while (iCountCicle>0) do
653
        begin
654

655
          for i:=0 to SYSTEM_PATHVARS.Count-1 do
656
          begin
657
              sPath:=UTF8StringReplace(sPath,SYSTEM_PATHVARS.Names[i],SYSTEM_PATHVARS.ValueFromIndex[i],[rfIgnoreCase]);
658
          end;
659

660
          dec(iCountCicle);
661
        end;
662
        APath:=sPath;
663

664
        if UTF8Pos('%',APath)=0 then
665
        begin
666
          Result :=True;
667
        end;
668

669
      end
670
      else begin
671
        Result :=True;
672
      end;
673

674
  {$ELSE}
675
      Result :=False;;
676
  {$ENDIF}
677

678
end;
679

680
function GetGUID: String;
681
var
682
  ID: TGUID;
683
begin
684
  Result := '';
685
   if SysUtils.CreateGUID(ID) = S_OK then
686
      Result := GUIDToString(ID);
687
  {$IFDEF WINDOWS}
688
  //Windows
689
  //if ActiveX.CoCreateGuid(ID) = S_OK then
690
  //  Result := GUIDToString(ID);
691
  {$ENDIF WINDOWS}
692
  {$IFDEF UNIX}
693

694
  {$ENDIF UNIX}
695
end;
696

697
{
698
 EXTENDED_NAME_FORMAT enumeration (secext.h)
699
 Minimum Windows 2000 Server
700
 Minimum Windows 2000 Professional
701
}
702
function GetUserNameExString(ANameFormat: DWORD): string;
703
const
704
  NameUnknown = 0; // Unknown name type.
705
  NameFullyQualifiedDN = 1; // Fully qualified distinguished name
706
  NameSamCompatible = 2; // Windows NT® 4.0 account name
707
  NameDisplay = 3; // A "friendly" display name
708
  NameUniqueId = 6; // GUID string that the IIDFromString function returns
709
  NameCanonical = 7; // Complete canonical name
710
  NameUserPrincipal = 8; // User principal name
711
  NameCanonicalEx = 9;
712
  NameServicePrincipal = 10; // Generalized service principal name
713
  DNSDomainName = 11; // DNS domain name, plus the user name
714
  NameDnsDomain = 12; // The DNS domain name followed by a backward-slash and the SAM user name.
715
  NameGivenName = 13; // The first name or given name of the user.
716
  NameSurname = 14; // The last name or surname of the user.
717
var
718
  Buf: array[0..256] of Char;
719
  BufSize: DWORD;
720
begin
721
  Result := '';
722
  BufSize := SizeOf(Buf) div SizeOf(Buf[0]);
723
  if JwaWindows.GetUserNameEx(ANameFormat, @Buf[0], BufSize) then
724
    Result := Buf;
725
end;
726

727
function GetADUserData(var AOutData:TADUserData):Boolean;
728
var
729
  rUser:TADUserData;
730
begin
731
   Result:=False;
732
   try
733
     rUser.ADUser                    :=False;
734
     rUser.NameFullyQualifiedDN      :=WinCPTOUTF8(GetUserNameExString(1));
735
     rUser.NameSamCompatible         :=WinCPTOUTF8(GetUserNameExString(2));
736
     rUser.NameDisplay               :=WinCPTOUTF8(GetUserNameExString(3));
737
     rUser.NameUniqueId              :=WinCPTOUTF8(GetUserNameExString(6));
738
     rUser.NameCanonical             :=WinCPTOUTF8(GetUserNameExString(7));
739
     rUser.NameUserPrincipal         :=WinCPTOUTF8(GetUserNameExString(8));
740
     rUser.NameCanonicalEx           :=WinCPTOUTF8(GetUserNameExString(9));
741
     rUser.NameServicePrincipal      :=WinCPTOUTF8(GetUserNameExString(10));
742
     rUser.DNSDomainName             :=WinCPTOUTF8(GetUserNameExString(11));
743
     rUser.NameDnsDomain             :=WinCPTOUTF8(GetUserNameExString(12));
744
     rUser.NameGivenName             :=WinCPTOUTF8(GetUserNameExString(13));
745
     rUser.NameSurname               :=WinCPTOUTF8(GetUserNameExString(14));
746

747
     if (UTF8Length(rUser.NameUniqueId)>0)then
748
     begin
749
       rUser.ADUser                  :=True;
750
     end;
751
     AOutData                        :=rUser;
752
     Result                          :=True;
753
   finally
754

755
   end;
756
end;
757

758
//Определение имени пользователя
759
{function GetUserName:String;
760
var
761
 Buffer: array[0..MAX_PATH] of Char;
762
 sz:DWord;
763
begin
764
 sz:=MAX_PATH-1;
765
 if windows.GetUserName(Buffer,sz)
766
 then begin
767
  if sz>0 then dec(sz);
768
  SetString(Result,Buffer,sz);
769
 end else begin
770
  Result:='';//inttostr(GetLastError);
771
 end;
772
end;}
773

774
function GetCurrentUserName : String;
775
{$IFDEF WINDOWS}
776
const
777
  MaxLen = 256;
778
var
779
  Len: DWORD;
780
  WS: WideString;
781
  Res: windows.BOOL;
782
{$ENDIF}
783
begin
784
  Result := '';
785
  {$IFDEF UNIX}
786
  {$IF (DEFINED(LINUX)) OR (DEFINED(FREEBSD))}
787
  Result := SysToUtf8(GetUserName(fpgetuid));   //GetUsername in unit Users, fpgetuid in unit BaseUnix
788
  {$ELSE Linux/BSD}
789
  Result := GetEnvironmentVariableUtf8('USER');
790
  {$ENDIF UNIX}
791
  {$ELSE}
792
      {$IFDEF WINDOWS}
793
      Len := MaxLen;
794
      {$IFnDEF WINCE}
795
      if Win32MajorVersion <= 4 then
796
      begin
797
        SetLength(Result,MaxLen);
798
        Res := Windows.GetuserName(@Result[1], Len);
799
        if Res then
800
        begin
801
          SetLength(Result,Len-1);
802
          Result := SysToUtf8(Result);
803
        end
804
        else SetLength(Result,0);
805
      end
806
      else
807
      {$ENDIF NOT WINCE}
808
      begin
809
        SetLength(WS, MaxLen-1);
810
        Res := Windows.GetUserNameW(@WS[1], Len);
811
        if Res then
812
        begin
813
          SetLength(WS, Len - 1);
814
          Result := LazUTF8.UTF16ToUTF8(WS);
815
        end
816
        else SetLength(Result,0);
817
      end;
818
      {$ENDIF WINDOWS}
819
  {$ENDIF UNIX}
820
end;
821

822
function GetCurrentComputerName : String;
823
{$IfDef WINDOWS}
824
var
825
   l: DWORD;
826
{$EndIf}
827
begin
828
    {$IfDef LINUX}
829
    Result := GetHostName;
830
    {$EndIf}
831
    {$IfDef WINDOWS}
832
    l := 255;
833
    SetLength(Result, l);
834
    GetComputerName(PChar(Result), l);
835
    SetLength(Result, l);
836
    {$EndIf}
837
    {$IfDef appleOS}
838
    {$EndIf}
839
end;
840

841
function GetLocalHostname: string;
842
var
843
 wVerReq: WORD;
844
 wsaData: TWSAData;
845
 h: PHostEnt;
846
 c: array[0..128] of char;
847
begin
848
 wVerReq:=MAKEWORD(1, 1);
849
 WSAStartup(wVerReq, wsaData);
850
 {Получаем хост (имя) компа}
851
 GetHostName(@c, 128);
852
 h:=GetHostByName(@c);
853
 Result := h^.h_Name; //Host отображает хост(имя) компьютера
854
end;
855

856
function GetLocalIP: string;
857
var
858
 wVerReq: WORD;
859
 wsaData: TWSAData;
860
 h: PHostEnt;
861
 c: array[0..128] of char;
862
begin
863
 wVerReq:=MAKEWORD(1, 1);
864
 WSAStartup(wVerReq, wsaData);
865
 {Получаем хост (имя) компа}
866
 GetHostName(@c, 128);
867
 h:=GetHostByName(@c);
868
 {Достаем IP}
869
 Result := iNet_ntoa(PInAddr(h^.h_addr_list^)^);
870
end;
871

872
function StartApp(AFileName, AParams:String): Integer;
873
var
874
  NewAppFileName,
875
  NewAppParams:string;
876
begin
877
try
878
        if FileExistsUTF8(AFileName) then
879
        begin
880
            NewAppFileName :=UTF8ToWinCP(AFileName);
881
            NewAppParams   :='';
882

883
            if AParams<>'' then
884
            begin
885
               NewAppParams:=UTF8ToWinCP(AParams);
886
            end;
887
            {$IFDEF WINDOWS}
888
            ShellExecute(0, 'open', PChar(NewAppFileName),
889
                            Pchar(NewAppParams), '', SW_SHOWNORMAL);
890
            Result:=1;
891
            {$ENDIF}
892
            {$IFDEF UNIX}
893
            AKey:='';
894
            AMsg:='Команда не адаптирована для unix.';
895
            OwnerApp.SystemLog(AKey, AMsg);
896
            {$ENDIF}
897
        end else begin
898
             Application.MessageBox(PChar('Не найден запускаемый файл'),Pchar(Application.Title),MB_ICONERROR);
899
             Result:=0;
900
        end;
901
except
902
  on E: Exception do
903
  begin
904
     Application.MessageBox(PChar('Ошибка при попытке запуска программы'),Pchar(Application.Title),MB_ICONERROR);
905
     Result:=-1;
906
  end;
907
end;
908
end;
909

910
function ChangeCurrentDirectory: boolean;
911
var
912
  sBuffer:Pchar;
913
  sExeFilePath:String;
914
begin
915
    Result:=False;
916
    {$IFDEF WINDOWS}
917
         sExeFilePath :=ParamStr(0);
918
         sExeFilePath :=ExtractFilePath(sExeFilePath);
919
         sBuffer      :=PChar(sExeFilePath);
920
         if SetCurrentDirectory(sBuffer) then
921
         begin
922
            Result:=True;
923
         end;
924
         {
925
         if GetCurrentDirectory(255,sBuffer)>0 then
926
         sBuffer:=Pchar(WinCPToUTF8(sBuffer));
927
         FThisApp.SystemLog(AKey, format('CurrentDirectory %s',[sBuffer]));
928
         }
929
     {$ENDIF}
930
end;
931

932
function GetEXEVersionData(const FileName: string; var OutData:TEXEVersionData): Boolean;
933
type
934
  PLandCodepage = ^TLandCodepage;
935
  TLandCodepage = record
936
    wLanguage,
937
    wCodePage: word;
938
  end;
939
var
940
  dummy,
941
  len: cardinal;
942
  buf, pntr: pointer;
943
  lang: string;
944
begin
945
  Result := False;
946
  try
947
     len := GetFileVersionInfoSize(PChar(FileName), dummy);
948
  except
949
     len :=0;
950
  end;
951

952
  if len>0 then
953
  begin
954
    //if len = 0 then
955
    //  RaiseLastOSError;
956
    GetMem(buf, len);
957
    try
958
      if not GetFileVersionInfo(PChar(FileName), 0, len, buf) then
959
        RaiseLastOSError;
960

961
      if not VerQueryValue(buf, '\VarFileInfo\Translation\', pntr, len) then
962
        RaiseLastOSError;
963

964
      lang := Format('%.4x%.4x', [PLandCodepage(pntr)^.wLanguage, PLandCodepage(pntr)^.wCodePage]);
965

966
      if VerQueryValue(buf, PChar('\StringFileInfo\' + lang + '\CompanyName'), pntr, len){ and (@len <> nil)} then
967
        OutData.CompanyName := PChar(pntr);
968
      if VerQueryValue(buf, PChar('\StringFileInfo\' + lang + '\FileDescription'), pntr, len){ and (@len <> nil)} then
969
        OutData.FileDescription := PChar(pntr);
970
      if VerQueryValue(buf, PChar('\StringFileInfo\' + lang + '\FileVersion'), pntr, len){ and (@len <> nil)} then
971
        OutData.FileVersion := PChar(pntr);
972
      if VerQueryValue(buf, PChar('\StringFileInfo\' + lang + '\InternalName'), pntr, len){ and (@len <> nil)} then
973
        OutData.InternalName := PChar(pntr);
974
      if VerQueryValue(buf, PChar('\StringFileInfo\' + lang + '\LegalCopyright'), pntr, len){ and (@len <> nil)} then
975
        OutData.LegalCopyright := PChar(pntr);
976
      if VerQueryValue(buf, PChar('\StringFileInfo\' + lang + '\LegalTrademarks'), pntr, len){ and (@len <> nil)} then
977
        OutData.LegalTrademarks := PChar(pntr);
978
      if VerQueryValue(buf, PChar('\StringFileInfo\' + lang + '\OriginalFileName'), pntr, len){ and (@len <> nil)} then
979
        OutData.OriginalFileName := PChar(pntr);
980
      if VerQueryValue(buf, PChar('\StringFileInfo\' + lang + '\ProductName'), pntr, len){ and (@len <> nil)} then
981
        OutData.ProductName := PChar(pntr);
982
      if VerQueryValue(buf, PChar('\StringFileInfo\' + lang + '\ProductVersion'), pntr, len){ and (@len <> nil)} then
983
        OutData.ProductVersion := PChar(pntr);
984
      if VerQueryValue(buf, PChar('\StringFileInfo\' + lang + '\Comments'), pntr, len){ and (@len <> nil)} then
985
        OutData.Comments := PChar(pntr);
986
      if VerQueryValue(buf, PChar('\StringFileInfo\' + lang + '\PrivateBuild'), pntr, len){ and (@len <> nil)} then
987
        OutData.PrivateBuild := PChar(pntr);
988
      if VerQueryValue(buf, PChar('\StringFileInfo\' + lang + '\SpecialBuild'), pntr, len){ and (@len <> nil)} then
989
        OutData.SpecialBuild := PChar(pntr);
990

991
      Result := True;
992
    finally
993
      FreeMem(buf);
994
    end;
995

996
  end;
997
end;
998

999
//look ForceDirectory
1000
{
1001
function CreateDirEx(Dir: string): Boolean;
1002
var
1003
  I, L: Integer;
1004
  CurDir: string;
1005
begin
1006
  Result := False;
1007
  CurDir :='';
1008
  Dir    :=UTF8ToSys(Dir);
1009
  if SysUtils.ExcludeTrailingPathDelimiter(Dir) <> '' then
1010
  begin
1011
      Dir := SysUtils.IncludeTrailingPathDelimiter(Dir);
1012
      L   := Length(Dir);
1013
      for I := 1 to L do
1014
      begin
1015
        CurDir := CurDir + Copy(Dir,I,1);
1016
        if Copy(Dir,I,1) = SysUtils.PathDelim then
1017
        begin
1018
          if not DirectoryExists(CurDir) then
1019
            if not CreateDir(CurDir) then
1020
              Exit;
1021
        end;
1022
      end;
1023
      if DirectoryExists(Dir) then
1024
         Result := True;
1025
  end;
1026
end;
1027
}
1028
function PathExists(APath: String; ACreate: Boolean): boolean;
1029
var
1030
  sPath:String;
1031
begin
1032
  Result := False;
1033
  if Length(APath)>0 then
1034
  begin
1035
    sPath  :=IncludeTrailingPathDelimiter(APath);
1036
    if (not DirPathExists(sPath))and(ACreate) then
1037
    begin
1038
       if ForceDirectory(sPath) then
1039
          Result := True;
1040
	  end
1041
    else begin
1042
          Result := True;
1043
    end;
1044
  end;
1045
end;
1046

1047
{ TNMDialogFormActions }
1048

1049
procedure TNMDialogFormActions.ButtonClose(Sender: TObject);
1050
var
1051
  TmpParent: TWinControl;
1052
begin
1053
  if (Sender is TButton) then
1054
  begin
1055
     TmpParent:=TButton(Sender).Parent;
1056
     TmpParent:=TmpParent.Parent;
1057
     TForm(TmpParent).Close;
1058
  end;
1059
end;
1060

1061
procedure TNMDialogFormActions.FormClose(Sender: TObject;
1062
  var CloseAction: TCloseAction);
1063
begin
1064
   CloseAction:=caFree;
1065
end;
1066

1067
Initialization
1068
  SYSTEM_PATHVARS_INITED    :=False;
1069
  SYSTEM_PATHVARS           :=TStringList.Create;
1070
  SYSTEM_PATHVARS.Delimiter :='=';
1071
  SetProgramPathToVar;
1072
  SetSystemPathParamsToVar;
1073
  NMDialogFormActions       :=TNMDialogFormActions.Create;
1074

1075
finalization
1076
  NMDialogFormActions.Free;
1077
  SYSTEM_PATHVARS.Free;
1078
end.