Functions/Misc/UnitMisc.pas

   1 {   This file is part of WineLauncher.
   2
   3     WineLauncher is free software: you can redistribute it and/or modify
   4     it under the terms of the GNU General Public License as published by
   5     the Free Software Foundation, version 3 of the License.
   6
   7     WineLauncher is distributed in the hope that it will be useful,
   8     but WITHOUT ANY WARRANTY; without even the implied warranty of
   9     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  10     GNU General Public License for more details.
  11
  12     You should have received a copy of the GNU General Public License
  13     along with WineLauncher.  If not, see <http://www.gnu.org/licenses/>.
  14 }
  15
  16 unit UnitMisc;
  17
  18 {$mode objfpc}{$H+}
  19
  20 interface
  21
  22 uses
  23   Classes, SysUtils, strutils, BaseUnix, Process, StdCtrls, FileUtil, Graphics;
  24
  25   procedure Log(Level:integer; Channel:string; LogText:string);
  26   procedure ListFileDir({0} Path:string; {1} FileList:TStrings; {2} GroupList:TStrings; {3} DirListClean:TStrings; {4} DirListPath:TStrings; {5} isFileList:Boolean);
  27   procedure FullClear(ComboBox:TComboBox);
  28   {$IFDEF LogVar}
  29    procedure LogVar(MyVar:string; MyVarName:string);
  30   {$ENDIF}
  31
  32   function Wrap(Input:string):string;  { Makes Paths look better, E.G. " ( Input ) " }
  33   function WinToUnixPath(Path:string):string;
  34   function UnixToWinPath(Path:string; DriveChar:Char):string;
  35   function GetUnixDirPath(FilePath:string):string;
  36   function FileExistsAndIsExecutable(FullPath:string; JustCheckExists:boolean): boolean ;
  37   function WorkDirTemplate(FolderPath:string):string;
  38   function DoesFolderExists(Path:string; FolderName:string): boolean;
  39   function DoesFolderExists(FullFolderPath:string): boolean;
  40   function DoesFoldersExists(Path:string; FolderNames:Tstrings): boolean;
  41   function DirExistsIfNotMakeIt(Path:string; FolderName:string ): boolean;
  42   function DirExistsIfNotMakeIt(PathWithFolder:string): boolean;
  43   function MakeFile(FullPath:string;Data:string):boolean;
  44   function SetExecutableFlag(FullPath:string):boolean;
  45   function ColourCheck(Input: TEdit):boolean;
  46   function CutUpFlags(Flags:string):boolean;
  47   function FindPrefixInt(PrefixName:string):integer;
  48   function GetWinFileName(FullPath:string):string;
  49   function FolderScan(ComboBox:TComboBox; Path:string):boolean;
  50   function SelectItem(ComboBox:TComboBox; ItemName:string):boolean;
  51   function SearchForBin(FileName:string):string;
  52   function FindWine(Path:string):string;
  53   function FCreatePrefixProcess(PrefixName:string):boolean;
  54
  55 //var
  56
  57 implementation
  58 uses
  59   UnitInitialization,
  60   UnitMain,
  61   UnitSettings,
  62   UnitProgramsList;
  63
  64 function FileExistsAndIsExecutable(FullPath:string; JustCheckExists:boolean): boolean ;
  65 var
  66 ChannelLocal:string;
  67 begin
  68 ChannelLocal := ('FileExistsAndIsExecutable');
  69
  70 if JustCheckExists = true then
  71    begin
  72         if FileExists(FullPath) then
  73         begin
  74              {$IFDEF MoreTrue }
  75               if JustCheckExists = true then Log(3, ChannelLocal, 'File' + Wrap(FullPath) + 'exists.');
  76              {$ENDIF}
  77              Result := true;
  78         end
  79            else
  80                begin
  81                     Log(4, ChannelLocal,'File' + Wrap(FullPath) + 'does not exists.');
  82                     Result := false;
  83                end;
  84    end
  85       else
  86           begin
  87                if FpAccess(FullPath, X_OK {Exe flag check}) <> 0 then
  88                  begin
  89                       Log(4, ChannelLocal,'File' + Wrap(FullPath) + 'is not executable.');
  90                       Result := false;
  91                  end
  92                     else
  93                         begin
  94                              {$IFDEF MoreTrue }
  95                               Log(3, ChannelLocal,'File' + Wrap(FullPath) + 'is executable.');
  96                              {$ENDIF}
  97                              Result := true;
  98                         end;
  99
 100     end;
 101 end;
 102
 103 function Wrap(Input: string):string;
 104 begin
 105      Result := ( ' ( ' + Input + ' ) ' );
 106 end;
 107
 108 function DoesFoldersExists(Path:string; FolderNames:Tstrings): boolean;
 109 var
 110 loop:integer;
 111 begin
 112 Result := true;
 113 { Take a path and check to see if the listed folders exists in that path. }
 114 { TODO : Add a way to check the result from each one and return it. }
 115      for loop := 0 to ( FolderNames.Count - 1 ) do
 116          begin
 117               if DoesFolderExists(Path, FolderNames[loop]) = false then
 118                  begin
 119                       Result := false;
 120                       Exit;
 121                  end;
 122          end;
 123 end;
 124
 125 function DoesFolderExists(Path:string; FolderName:string): boolean;
 126 var
 127 ChannelLocal:string;
 128 begin
 129 ChannelLocal := 'DoesFolderExists';
 130      if DirectoryExists(Path + FolderName) = true then
 131         begin
 132              Result := true ;
 133              {$IFDEF MoreTrue}
 134               Log(3, ChannelLocal, ('Folder' + Wrap(Path + FolderName) + 'exists.'));
 135              {$ENDIF}
 136         end
 137            else
 138                begin
 139                     Result := false ;
 140                     Log(4, ChannelLocal, ('Folder' + Wrap(Path + FolderName) + 'does not exists.'));
 141                end;
 142 end;
 143
 144 function DoesFolderExists(FullFolderPath:string): boolean;
 145 var
 146 ChannelLocal:string;
 147 begin
 148 ChannelLocal := 'DoesFolderExists';
 149      if DirectoryExists(FullFolderPath) = true then
 150         begin
 151              Result := true ;
 152              {$IFDEF MoreTrue}
 153               Log(3, ChannelLocal, ('Folder' + Wrap(FullFolderPath) + 'exists.'));
 154              {$ENDIF}
 155         end
 156            else
 157                begin
 158                     Result := false ;
 159                     Log(4, ChannelLocal, ('Folder' + Wrap(FullFolderPath) + 'does not exists.'));
 160                end;
 161 end;
 162
 163 procedure Log(Level:integer; Channel:string; LogText:string);
 164 var
 165    LevelString:string;
 166    OutPut:string;
 167 begin
 168      {Level 0 "Info"}
 169      {Level 1 "Error"}
 170      {Level 2 "Variable"}
 171      {Level 3 "Dev-Info"}
 172      {Level 4 "Dev-Error"}
 173      {Level 5 is for uses with custom functions.}
 174
 175      Case Level of
 176        0: LevelString := 'Info';
 177        1: LevelString := 'Error';
 178        2: LevelString := 'Variable';
 179        3: LevelString := 'Dev-Info';
 180        4: LevelString := 'Dev-Error';
 181      end;
 182
 183      if Level = 5 then
 184         begin
 185              OutPut := (LogText);
 186         end
 187            else
 188                begin
 189                    if HideChannel = true then
 190                       begin
 191                            OutPut := (LevelString + ': ' + LogText);
 192                       end
 193                          else
 194                              begin
 195                                   OutPut := (LevelString + ':' + Channel + ': ' + LogText);
 196                              end;
 197                end;
 198      {Output}
 199      WriteLn(OutPut);
 200      if UnitMain.form1 <> nil then
 201         begin
 202              UnitMain.form1.Memo_LogOutPut.Lines.Add(OutPut);
 203         end;
 204 end;
 205
 206 function WinToUnixPath(Path:string):string;
 207 var
 208 PathUpToDosdevices:string;
 209 DriveNameWithSlash:string;
 210 FullUnixPath:string;
 211 begin
 212      {Get the path up to Dosdevices.}
 213      PathUpToDosdevices := (PathToPrefix + UnitMain.form1.ComboBox_PreFix.Text + '/dosdevices/' );
 214      {Take the DriveName off 'path' and replace '\' with '/'.}
 215      DriveNameWithSlash := (AnsiLowerCase( Copy2SymbDel( Path, '\' )) + '/');
 216      {Replace all '\' to '/'.}
 217      Path := AnsiReplaceText(Path, '\', '/');
 218      {Sort then.}
 219      FullUnixPath := (PathUpToDosdevices + DriveNameWithSlash + Path);
 220 {$IFDEF LogVar}
 221  {$IFDEF MOREDEBUG_WinToUnixPath}
 222   logVar(PathUpToDosdevices, 'PathUpToDosdevices');
 223   logVar(DriveNameWithSlash, 'DriveNameWithSlash');
 224   logVar(Path, 'Path');
 225  {$ENDIF}
 226  logVar(FullUnixPath, 'FullUnixPath');
 227 {$ENDIF}
 228  Result := FullUnixPath;
 229
 230 end;
 231
 232
 233 function UnixToWinPath(Path:string; DriveChar:Char):string;
 234 var
 235 WindowsFilePath :string;
 236 SmallPath:string;
 237 Cleanup:string;
 238 begin
 239      if Path = '' then
 240         begin
 241              Result := '';
 242              exit;
 243         end;
 244
 245      Path := AnsiReverseString(Path);
 246      SmallPath := Copy2SymbDel(Path, ':');
 247      SmallPath := AnsiReverseString(SmallPath);
 248      Cleanup := AnsiReplaceText(SmallPath, '/', '\');
 249      WindowsFilePath := (DriveChar + ':' + Cleanup);
 250
 251      {$IFDEF LogVar}
 252       {$IFDEF MOREDEBUG_UnixToWinPath}
 253        logVar(WindowsFilePath, 'WindowsFilePath');
 254       {$ENDIF}
 255      {$ENDIF}
 256      Result := WindowsFilePath;
 257 end;
 258
 259
 260 function GetUnixDirPath(FilePath:string):string;
 261 var
 262 DirPath:string;
 263 //LocalChannel:string;
 264 begin
 265      DirPath := LeftStr(FilePath, (Rpos('/',FilePath) ));
 266      //log(0, LocalChannel, ( 'VAR ' + DirPath));
 267
 268      Result := DirPath;
 269 end;
 270
 271 function WorkDirTemplate(FolderPath:string):string;
 272 begin
 273      Result := ('cd "' + FolderPath + '";' + #10 );
 274 end;
 275
 276 {$IFDEF LogVar}
 277  procedure LogVar(MyVar: string; MyVarName: string);
 278  begin
 279       Log(2, 'LogVar', ( Wrap( MyVarName ) + 'is' + Wrap( MyVar )) );
 280  end;
 281 {$ENDIF}
 282
 283 function DirExistsIfNotMakeIt(Path:string; FolderName:string ): boolean;
 284 var
 285 LocalChannel:string; {Ignore this for now}
 286 begin
 287 LocalChannel := '';
 288
 289      if FolderName <> '' then
 290         begin
 291              if DirectoryExists( Path + FolderName ) = true then
 292                 begin
 293                      Log(0, LocalChannel, ('Directory' + Wrap( Path + FolderName ) + 'exists.')) ;
 294                      Result := true;
 295                 end
 296                    else
 297                        begin
 298                             Log(0, LocalChannel, ('Directory' + Wrap( Path + FolderName ) + ' does not exists.')) ;
 299                             if CreateDir( Path + FolderName ) then
 300                                begin
 301                                     Log(0, LocalChannel, ('File' + Wrap( Path + FolderName ) + 'has being created.')) ;
 302                                     Result := true;
 303                                end
 304                                   else
 305                                       begin
 306                                            Log(0, LocalChannel, ('File' + Wrap( Path + FolderName ) + 'can not be created.')) ;
 307                                            Result := true;
 308                                       end;
 309                        end;
 310
 311         end
 312            else
 313                begin
 314                     Result := false;
 315                end;
 316 end;
 317
 318 function DirExistsIfNotMakeIt(PathWithFolder:string): boolean;
 319 var
 320 FolderPath:string;
 321 FolderName:string;
 322 begin
 323      {E.G. PathWithFolder := '/home/test/hello/'.}
 324
 325      {If PathWithfolder has '/' at the end remove it.}
 326      RemoveTrailingChars(PathWithFolder,['/']);
 327
 328      {FolderName := 'hello'.}
 329      FolderName := ExtractFileName(PathWithFolder);
 330
 331      {FolderPath := '/home/test/'.}
 332      FolderPath := ExtractFilePath(PathWithFolder);
 333
 334      {$IFDEF LogVar}
 335      logVar(FolderName, 'FolderName');
 336      logVar(FolderPath, 'FolderPath');
 337      {$ENDIF}
 338
 339      {Pass the data to real function and get the result back.}
 340      if DirExistsIfNotMakeIt(FolderPath, FolderName) = true then Result := true else Result := false;
 341 end;
 342
 343 function MakeFile(FullPath:string;Data:string):boolean;
 344 var
 345 FD1:Cint;
 346 CL:string;
 347 begin
 348      CL := 'MakeFile';
 349      FpUnlink(FullPath);
 350
 351      FD1 := fpOpen (FullPath, O_WrOnly or O_Creat);
 352      if FD1 > 0 then
 353         begin
 354              if length(Data)<>fpwrite (FD1,Data[1],Length(Data)) then
 355                 begin
 356                      Result := False ;
 357                      Log(1, CL, ('When writing to' + Wrap(FullPath)) );
 358                 end
 359                    else
 360                        begin
 361                             {$IFDEF MoreTrue }
 362                              Log(3, CL, ('File' + Wrap(FullPath) + 'has being created'));
 363                             {$ENDIF}
 364                             Result := true;
 365                        end;
 366            fpClose(FD1);
 367         end;
 368 end;
 369
 370 function SetExecutableFlag(FullPath:string):boolean;
 371 var
 372 ChannelLocal:string;
 373 begin
 374      {770 is owner rwx, group rwx, other nothing}
 375      if fpChmod (FullPath,&770) <> 0 then {0 = no error}
 376         begin
 377              Log(1, ChannelLocal, ('Can not set executable flag on' + Wrap(FullPath)) );
 378              Result := False;
 379         end
 380            else
 381                begin
 382                     {$IFDEF MoreTrue }
 383                      Log(0, ChannelLocal, ('Executable flag has being set on' + Wrap(FullPath)) );
 384                     {$ENDIF}
 385                     Result := true;
 386                end;
 387 end;
 388
 389 function ColourCheck(Input: TEdit):boolean;
 390 var
 391 LocalChannel:string;
 392 temp:string;
 393 begin
 394 LocalChannel := 'ColourCheck';
 395 {This does a CaseInsensitive check to see if the file exists. Wine does not care about the executable flag. }
 396 {I can not find FindDiskFileCaseInsensitive in the doc.}
 397 {If it can not find the file it will return nothing and it will clear the string.}
 398     temp := WinToUnixPath(Input.Text);
 399
 400     if FindDiskFileCaseInsensitive(temp) <> '' then
 401        begin
 402             {$IFDEF MoreTrue}Log(3, LocalChannel, 'File' + Wrap(temp) + 'exists.');{$ENDIF}
 403             Input.Font.Color := clgreen;
 404             Result := true;
 405        end
 406           else
 407               begin
 408                    Log(4, LocalChannel,'File' + Wrap(Input.Text) + 'does not exists.');
 409                    Input.Font.Color := clred;
 410                    Result := false;
 411               end;
 412 end;
 413
 414 function CutUpFlags(Flags:string):boolean;
 415 var
 416 Loop:integer;
 417 Dump:integer;
 418 Temp:string;
 419 begin
 420      UnitMain.form1.CheckListBox_Flags.Items.Clear;
 421
 422      for loop := 0 to ( WordCount( Flags, [';'] )  ) do
 423      begin
 424           Dump := FindPart( ';', Flags );
 425           Temp  := LeftStr( Flags, Dump - 1);
 426           if Temp <> '' then UnitMain.form1.CheckListBox_Flags.Items.Add(Temp);
 427           Delete(Flags, 1, (Dump)) ;
 428      end;
 429      if Flags <> '' then UnitMain.form1.CheckListBox_Flags.Items.Add(Flags);
 430
 431 end;
 432
 433 function FindPrefixInt(PrefixName:string):integer;
 434 var
 435    Loop:integer;
 436 const
 437    C = 'FindPrefixInt';
 438 begin
 439      {Error code is -1}
 440      Result := -1;
 441
 442      for loop := 0 to (UnitMain.form1.ComboBox_PreFix.items.Count -1) do begin
 443          if Data[loop].PrefixName = PrefixName then
 444             begin
 445                  Result := loop;
 446                  exit;
 447             end;
 448      end;
 449
 450      if Result = -1 then log(1, C, ('Prefix' + Wrap(PrefixName) + 'does not exist.'));
 451 end;
 452
 453 function GetWinFileName(FullPath:string):string;
 454 begin
 455      {Take path and return the file name only.}
 456      {d:\Somefoldername\'Setup'.exe}
 457
 458      FullPath := AnsiReverseString(FullPath);
 459      FullPath := Copy2Symb(FullPath, '\');
 460      Copy2SymbDel(FullPath, '.');
 461      FullPath := AnsiReverseString(FullPath);
 462
 463      Result := FullPath;
 464 end;
 465
 466 procedure ListFileDir({0} Path:string; {1} FileList:TStrings; {2} GroupList:TStrings; {3} DirListClean:TStrings; {4} DirListPath:TStrings; {5} isFileList:Boolean);
 467 var
 468   SR:TSearchRec;
 469 begin
 470 if FindFirst(Path + '*', faAnyFile , SR) = 0 then
 471 begin
 472      repeat
 473            if ((SR.Attr and faDirectory = 0) = isFileList) then
 474            begin
 475                 {Removes folders called "." & "..".}
 476                 if SR.Name <> '.' then
 477                 if SR.Name <> '..' then
 478                 begin
 479                      if (DirListPath <> nil) then
 480                        DirListPath.Add(path + SR.Name + '/');
 481                      if (FileList <> nil) then
 482                        FileList.Add(SR.Name);
 483                 end;
 484            end;
 485      until FindNext(SR) <> 0;
 486           FindClose(SR);
 487      end;
 488 end;
 489
 490 function FolderScan(ComboBox:TComboBox; Path:string):boolean;
 491 var
 492   Channel:string;
 493   List:Tstringlist;
 494   TempStr:string;
 495   TempInt:integer;
 496 begin
 497      List := TStringlist.Create;
 498      ListFileDir({0} Path, {1} List, {2} nil, {3} nil, {4} nil, {5} false);
 499      {$IFDEF LogVar}
 500        {$IFDEF MOREDEBUG_FolderScan}
 501         LogVar(Path, (ComboBox.Name + ' Path'));
 502         Logvar(List.Text, (ComboBox.Name + ' List'));
 503        {$ENDIF}
 504      {$ENDIF}
 505
 506      if ComboBox.Sorted = true then List.Sorted := true else List.Sorted := false;
 507
 508      if List.Text <> ComboBox.Items.Text then
 509      begin
 510           {$IFDEF MOREDEBUG_FolderScan}
 511            log(0, Channel, (ComboBox.Name + ' does not equal the new list.'));
 512           {$ENDIF}
 513           {Store selected item.}
 514           if ComboBox.Text <> '' then TempStr := ComboBox.Text;
 515
 516           {Having the caption set stops this code from working correctly on GTK1.}
 517           FullClear(ComboBox);
 518           ComboBox.Items := List;
 519           {Reselect item.}
 520           TempInt := ComboBox.Items.IndexOf(TempStr);
 521           if TempInt <> -1 then ComboBox.ItemIndex := TempInt;
 522      end;
 523
 524      List.Destroy;
 525      Result := true;
 526 end;
 527
 528 function SelectItem(ComboBox:TComboBox; ItemName:string):boolean;
 529 var
 530   TempInt:integer;
 531   //Channel:string;
 532 begin
 533      {Need to add some debug logging.}
 534      //Channel := 'SelectItem';
 535
 536      TempInt := ComboBox.Items.IndexOf(ItemName);
 537      if TempInt <> -1 then
 538      begin
 539           if ComboBox.Items.Strings[TempInt] <> '' then
 540           begin
 541                ComboBox.ItemIndex := TempInt;
 542           end
 543              else
 544                  begin
 545                       //Log(0, Channel, '');
 546                  end;
 547      end;
 548 end;
 549
 550 procedure FullClear(ComboBox:TComboBox);
 551 begin
 552      {Having the caption set stops the code from working correctly on GTK1.}
 553      {GTK2 with style set to csDropDownList never sets the caption.}
 554      ComboBox.Caption := '';
 555      ComboBox.Clear;
 556 end;
 557
 558 function SearchForBin(FileName:string):string;
 559 begin
 560      Result := FileSearch(FileName, GetEnvironmentVariable('PATH'));
 561      {$IFDEF MOREDEBUG_SearchForBin}
 562       {$IFDEF LogVar}
 563        LogVar(Result, 'SearchForBin');
 564       {$ENDIF}
 565      {$ENDIF}
 566 end;
 567
 568 function FindWine(Path:string):string;
 569 const
 570 ChannelLocal = 'FindWine';
 571 begin
 572      {This function will look for wine in Path and sub folder bin for wine.}
 573      {If it finds wine it will return the full path with file name, else it will return a empty string.}
 574      {Path should be 'PathToWine' + DistributionName + DistributionVersion + Architecture + ComboBox_WineVersion.}
 575      if FileExistsAndIsExecutable((Path + '/wine'), false) = true then
 576      begin
 577           Result := (Path + '/wine');
 578           {$IFDEF LogVar}
 579            LogVar(Result, 'wine_version_full_path');
 580           {$ENDIF}
 581      end
 582         else
 583             if FileExistsAndIsExecutable((Path + '/bin/wine'), false) = true then
 584                begin
 585                     Result := (Path + '/bin/wine');
 586                     {$IFDEF LogVar}
 587                      LogVar(Result, 'wine_version_full_path');
 588                     {$ENDIF}
 589                end
 590                   else
 591                       begin
 592                            Log(0, ChannelLocal, 'Can not find wine');
 593                            Result := '';
 594                       end;
 595 end;
 596
 597 function FCreatePrefixProcess(PrefixName:string):boolean;
 598 var
 599   PathToWinePrefixCreate:string;
 600   Path:string;
 601   Trap:boolean;
 602 const
 603   InstalledLayout = '/bin/wineprefixcreate';
 604   GitLayout = '/tools/wineprefixcreate';
 605 begin
 606      if PrefixName = '' then
 607      begin
 608           log(1,'', 'No name for the prefix!');
 609           exit(false);
 610      end;
 611
 612      PathToWinePrefixCreate := (PathToWine + UnitMain.form1.ComboBox_WineVersion.Text);
 613
 614      {Try to find it using the installed layout.}
 615      if FileExistsAndIsExecutable(PathToWinePrefixCreate + InstalledLayout, false) = false then
 616      begin
 617           {Try to find it using the wine git layout.}
 618           if FileExistsAndIsExecutable(PathToWinePrefixCreate + GitLayout, false) = false then
 619           begin
 620                log(1,'', 'Can not find wineprefixcreate or it is not executable.');
 621                exit(false);
 622           end
 623              else
 624                  begin
 625                       {It's the git layout.}
 626                       PathToWinePrefixCreate := (PathToWinePrefixCreate + GitLayout);
 627                  end;
 628      end
 629         else
 630             begin
 631                  {It's the installed layout.}
 632                  PathToWinePrefixCreate := (PathToWinePrefixCreate + InstalledLayout);
 633             end;
 634
 635      {Note the is no = sign in this path.}
 636      Path := ('"' +PathToWinePrefixCreate + '" --prefix ' + '"' + PathToPrefix + PrefixName + '"');
 637      {$IFDEF LogVar}
 638       logVar(Path, 'Path');
 639      {$ENDIF}
 640      CreatePrefixProcess.CommandLine := Path;
 641      CreatePrefixProcess.Execute;
 642
 643      {This works but Winelauncher will hang until this process ends.}
 644      {This returns before it's realy done.}
 645      {PreFixExists will return false if you run it right after this.}
 646      Trap := true;
 647      while Trap = true do
 648      begin
 649           sleep(1);
 650           if CreatePrefixProcess.Running = false then
 651           begin
 652                Trap := false;
 653                if CreatePrefixProcess.ExitStatus = 0 then
 654                begin
 655                     Result := true;
 656                end
 657                   else
 658                       begin
 659                            log(1,'', 'Something when wrong with creating the prefix.');
 660                            Result := false;
 661                       end;
 662           end;
 663      end;
 664 end;
 665
 666 end.
 667