1 { This file is part of WineLauncher.
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.
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.
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/>.
23 Classes
, SysUtils
, strutils
, BaseUnix
, Process
, StdCtrls
, FileUtil
, Graphics
;
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
);
29 procedure LogVar(MyVar
:string; MyVarName
:string);
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;
64 function FileExistsAndIsExecutable(FullPath
:string; JustCheckExists
:boolean): boolean ;
68 ChannelLocal
:= ('FileExistsAndIsExecutable');
70 if JustCheckExists
= true then
72 if FileExists(FullPath
) then
75 if JustCheckExists
= true then Log(3, ChannelLocal
, 'File' + Wrap(FullPath
) + 'exists.');
81 Log(4, ChannelLocal
,'File' + Wrap(FullPath
) + 'does not exists.');
87 if FpAccess(FullPath
, X_OK
{Exe flag check}) <> 0 then
89 Log(4, ChannelLocal
,'File' + Wrap(FullPath
) + 'is not executable.');
95 Log(3, ChannelLocal
,'File' + Wrap(FullPath
) + 'is executable.');
103 function Wrap(Input
: string):string;
105 Result
:= ( ' ( ' + Input
+ ' ) ' );
108 function DoesFoldersExists(Path
:string; FolderNames
:Tstrings
): boolean;
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
117 if DoesFolderExists(Path
, FolderNames
[loop
]) = false then
125 function DoesFolderExists(Path
:string; FolderName
:string): boolean;
129 ChannelLocal
:= 'DoesFolderExists';
130 if DirectoryExists(Path
+ FolderName
) = true then
134 Log(3, ChannelLocal
, ('Folder' + Wrap(Path
+ FolderName
) + 'exists.'));
140 Log(4, ChannelLocal
, ('Folder' + Wrap(Path
+ FolderName
) + 'does not exists.'));
144 function DoesFolderExists(FullFolderPath
:string): boolean;
148 ChannelLocal
:= 'DoesFolderExists';
149 if DirectoryExists(FullFolderPath
) = true then
153 Log(3, ChannelLocal
, ('Folder' + Wrap(FullFolderPath
) + 'exists.'));
159 Log(4, ChannelLocal
, ('Folder' + Wrap(FullFolderPath
) + 'does not exists.'));
163 procedure Log(Level
:integer; Channel
:string; LogText
:string);
172 {Level 4 "Dev-Error"}
173 {Level 5 is for uses with custom functions.}
176 0: LevelString
:= 'Info';
177 1: LevelString
:= 'Error';
178 2: LevelString
:= 'Variable';
179 3: LevelString
:= 'Dev-Info';
180 4: LevelString
:= 'Dev-Error';
189 if HideChannel
= true then
191 OutPut
:= (LevelString
+ ': ' + LogText
);
195 OutPut
:= (LevelString
+ ':' + Channel
+ ': ' + LogText
);
200 if UnitMain
.form1
<> nil then
202 UnitMain
.form1
.Memo_LogOutPut
.Lines
.Add(OutPut
);
206 function WinToUnixPath(Path
:string):string;
208 PathUpToDosdevices
:string;
209 DriveNameWithSlash
:string;
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
, '\', '/');
219 FullUnixPath
:= (PathUpToDosdevices
+ DriveNameWithSlash
+ Path
);
221 {$IFDEF MOREDEBUG_WinToUnixPath}
222 logVar(PathUpToDosdevices
, 'PathUpToDosdevices');
223 logVar(DriveNameWithSlash
, 'DriveNameWithSlash');
224 logVar(Path
, 'Path');
226 logVar(FullUnixPath
, 'FullUnixPath');
228 Result
:= FullUnixPath
;
233 function UnixToWinPath(Path
:string; DriveChar
:Char):string;
235 WindowsFilePath
:string;
245 Path
:= AnsiReverseString(Path
);
246 SmallPath
:= Copy2SymbDel(Path
, ':');
247 SmallPath
:= AnsiReverseString(SmallPath
);
248 Cleanup
:= AnsiReplaceText(SmallPath
, '/', '\');
249 WindowsFilePath
:= (DriveChar
+ ':' + Cleanup
);
252 {$IFDEF MOREDEBUG_UnixToWinPath}
253 logVar(WindowsFilePath
, 'WindowsFilePath');
256 Result
:= WindowsFilePath
;
260 function GetUnixDirPath(FilePath
:string):string;
263 //LocalChannel:string;
265 DirPath
:= LeftStr(FilePath
, (Rpos('/',FilePath
) ));
266 //log(0, LocalChannel, ( 'VAR ' + DirPath));
271 function WorkDirTemplate(FolderPath
:string):string;
273 Result
:= ('cd "' + FolderPath
+ '";' + #10 );
277 procedure LogVar(MyVar
: string; MyVarName
: string);
279 Log(2, 'LogVar', ( Wrap( MyVarName
) + 'is' + Wrap( MyVar
)) );
283 function DirExistsIfNotMakeIt(Path
:string; FolderName
:string ): boolean;
285 LocalChannel
:string; {Ignore this for now}
289 if FolderName
<> '' then
291 if DirectoryExists( Path
+ FolderName
) = true then
293 Log(0, LocalChannel
, ('Directory' + Wrap( Path
+ FolderName
) + 'exists.')) ;
298 Log(0, LocalChannel
, ('Directory' + Wrap( Path
+ FolderName
) + ' does not exists.')) ;
299 if CreateDir( Path
+ FolderName
) then
301 Log(0, LocalChannel
, ('File' + Wrap( Path
+ FolderName
) + 'has being created.')) ;
306 Log(0, LocalChannel
, ('File' + Wrap( Path
+ FolderName
) + 'can not be created.')) ;
318 function DirExistsIfNotMakeIt(PathWithFolder
:string): boolean;
323 {E.G. PathWithFolder := '/home/test/hello/'.}
325 {If PathWithfolder has '/' at the end remove it.}
326 RemoveTrailingChars(PathWithFolder
,['/']);
328 {FolderName := 'hello'.}
329 FolderName
:= ExtractFileName(PathWithFolder
);
331 {FolderPath := '/home/test/'.}
332 FolderPath
:= ExtractFilePath(PathWithFolder
);
335 logVar(FolderName
, 'FolderName');
336 logVar(FolderPath
, 'FolderPath');
339 {Pass the data to real function and get the result back.}
340 if DirExistsIfNotMakeIt(FolderPath
, FolderName
) = true then Result
:= true else Result
:= false;
343 function MakeFile(FullPath
:string;Data
:string):boolean;
351 FD1
:= fpOpen (FullPath
, O_WrOnly
or O_Creat
);
354 if length(Data
)<>fpwrite (FD1
,Data
[1],Length(Data
)) then
357 Log(1, CL
, ('When writing to' + Wrap(FullPath
)) );
362 Log(3, CL
, ('File' + Wrap(FullPath
) + 'has being created'));
370 function SetExecutableFlag(FullPath
:string):boolean;
374 {770 is owner rwx, group rwx, other nothing}
375 if fpChmod (FullPath
,&770) <> 0 then {0 = no error}
377 Log(1, ChannelLocal
, ('Can not set executable flag on' + Wrap(FullPath
)) );
383 Log(0, ChannelLocal
, ('Executable flag has being set on' + Wrap(FullPath
)) );
389 function ColourCheck(Input
: TEdit
):boolean;
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);
400 if FindDiskFileCaseInsensitive(temp
) <> '' then
402 {$IFDEF MoreTrue}Log(3, LocalChannel
, 'File' + Wrap(temp
) + 'exists.');{$ENDIF}
403 Input
.Font
.Color
:= clgreen
;
408 Log(4, LocalChannel
,'File' + Wrap(Input
.Text) + 'does not exists.');
409 Input
.Font
.Color
:= clred
;
414 function CutUpFlags(Flags
:string):boolean;
420 UnitMain
.form1
.CheckListBox_Flags
.Items
.Clear
;
422 for loop
:= 0 to ( WordCount( Flags
, [';'] ) ) do
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
)) ;
429 if Flags
<> '' then UnitMain
.form1
.CheckListBox_Flags
.Items
.Add(Flags
);
433 function FindPrefixInt(PrefixName
:string):integer;
442 for loop
:= 0 to (UnitMain
.form1
.ComboBox_PreFix
.items
.Count
-1) do begin
443 if Data
[loop
].PrefixName
= PrefixName
then
450 if Result
= -1 then log(1, C
, ('Prefix' + Wrap(PrefixName
) + 'does not exist.'));
453 function GetWinFileName(FullPath
:string):string;
455 {Take path and return the file name only.}
456 {d:\Somefoldername\'Setup'.exe}
458 FullPath
:= AnsiReverseString(FullPath
);
459 FullPath
:= Copy2Symb(FullPath
, '\');
460 Copy2SymbDel(FullPath
, '.');
461 FullPath
:= AnsiReverseString(FullPath
);
466 procedure ListFileDir({0} Path
:string; {1} FileList
:TStrings
; {2} GroupList
:TStrings
; {3} DirListClean
:TStrings
; {4} DirListPath
:TStrings
; {5} isFileList
:Boolean);
470 if FindFirst(Path
+ '*', faAnyFile
, SR
) = 0 then
473 if ((SR
.Attr
and faDirectory
= 0) = isFileList
) then
475 {Removes folders called "." & "..".}
476 if SR
.Name
<> '.' then
477 if SR
.Name
<> '..' then
479 if (DirListPath
<> nil) then
480 DirListPath
.Add(path
+ SR
.Name
+ '/');
481 if (FileList
<> nil) then
482 FileList
.Add(SR
.Name
);
485 until FindNext(SR
) <> 0;
490 function FolderScan(ComboBox
:TComboBox
; Path
:string):boolean;
497 List
:= TStringlist
.Create
;
498 ListFileDir({0} Path
, {1} List
, {2} nil, {3} nil, {4} nil, {5} false);
500 {$IFDEF MOREDEBUG_FolderScan}
501 LogVar(Path
, (ComboBox
.Name
+ ' Path'));
502 Logvar(List
.Text, (ComboBox
.Name
+ ' List'));
506 if ComboBox
.Sorted
= true then List
.Sorted
:= true else List
.Sorted
:= false;
508 if List
.Text <> ComboBox
.Items
.Text then
510 {$IFDEF MOREDEBUG_FolderScan}
511 log(0, Channel
, (ComboBox
.Name
+ ' does not equal the new list.'));
513 {Store selected item.}
514 if ComboBox
.Text <> '' then TempStr
:= ComboBox
.Text;
516 {Having the caption set stops this code from working correctly on GTK1.}
518 ComboBox
.Items
:= List
;
520 TempInt
:= ComboBox
.Items
.IndexOf(TempStr
);
521 if TempInt
<> -1 then ComboBox
.ItemIndex
:= TempInt
;
528 function SelectItem(ComboBox
:TComboBox
; ItemName
:string):boolean;
533 {Need to add some debug logging.}
534 //Channel := 'SelectItem';
536 TempInt
:= ComboBox
.Items
.IndexOf(ItemName
);
537 if TempInt
<> -1 then
539 if ComboBox
.Items
.Strings
[TempInt
] <> '' then
541 ComboBox
.ItemIndex
:= TempInt
;
545 //Log(0, Channel, '');
550 procedure FullClear(ComboBox
:TComboBox
);
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
:= '';
558 function SearchForBin(FileName
:string):string;
560 Result
:= FileSearch(FileName
, GetEnvironmentVariable('PATH'));
561 {$IFDEF MOREDEBUG_SearchForBin}
563 LogVar(Result
, 'SearchForBin');
568 function FindWine(Path
:string):string;
570 ChannelLocal
= 'FindWine';
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
577 Result
:= (Path
+ '/wine');
579 LogVar(Result
, 'wine_version_full_path');
583 if FileExistsAndIsExecutable((Path
+ '/bin/wine'), false) = true then
585 Result
:= (Path
+ '/bin/wine');
587 LogVar(Result
, 'wine_version_full_path');
592 Log(0, ChannelLocal
, 'Can not find wine');
597 function FCreatePrefixProcess(PrefixName
:string):boolean;
599 PathToWinePrefixCreate
:string;
603 InstalledLayout
= '/bin/wineprefixcreate';
604 GitLayout
= '/tools/wineprefixcreate';
606 if PrefixName
= '' then
608 log(1,'', 'No name for the prefix!');
612 PathToWinePrefixCreate
:= (PathToWine
+ UnitMain
.form1
.ComboBox_WineVersion
.Text);
614 {Try to find it using the installed layout.}
615 if FileExistsAndIsExecutable(PathToWinePrefixCreate
+ InstalledLayout
, false) = false then
617 {Try to find it using the wine git layout.}
618 if FileExistsAndIsExecutable(PathToWinePrefixCreate
+ GitLayout
, false) = false then
620 log(1,'', 'Can not find wineprefixcreate or it is not executable.');
625 {It's the git layout.}
626 PathToWinePrefixCreate
:= (PathToWinePrefixCreate
+ GitLayout
);
631 {It's the installed layout.}
632 PathToWinePrefixCreate
:= (PathToWinePrefixCreate
+ InstalledLayout
);
635 {Note the is no = sign in this path.}
636 Path
:= ('"' +PathToWinePrefixCreate
+ '" --prefix ' + '"' + PathToPrefix
+ PrefixName
+ '"');
638 logVar(Path
, 'Path');
640 CreatePrefixProcess
.CommandLine
:= Path
;
641 CreatePrefixProcess
.Execute
;
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.}
650 if CreatePrefixProcess
.Running
= false then
653 if CreatePrefixProcess
.ExitStatus
= 0 then
659 log(1,'', 'Something when wrong with creating the prefix.');