sourcepawn/batchtool/uFunc.pas
author Nicholas Hastings <skamonkey@gmail.com>
Mon Feb 08 19:57:20 2010 -0800 (2010-02-08)
changeset 2914 bf5f9aa53abe
parent 1952 b7aa2b626807
permissions -rw-r--r--
Fixed FindEntityByClassname crash in Synergy (bug 4235, r=dvander).
ds@1952
     1
(* AMX Mod X
ds@1952
     2
*    compile.exe
ds@1952
     3
*
ds@1952
     4
* by the AMX Mod X Development Team
ds@1952
     5
*
ds@1952
     6
*
ds@1952
     7
*  This program is free software; you can redistribute it and/or modify it
ds@1952
     8
*  under the terms of the GNU General Public License as published by the
ds@1952
     9
*  Free Software Foundation; either version 2 of the License, or (at
ds@1952
    10
*  your option) any later version.
ds@1952
    11
*
ds@1952
    12
*  This program is distributed in the hope that it will be useful, but
ds@1952
    13
*  WITHOUT ANY WARRANTY; without even the implied warranty of
ds@1952
    14
*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
ds@1952
    15
*  General Public License for more details.
ds@1952
    16
*
ds@1952
    17
*  You should have received a copy of the GNU General Public License
ds@1952
    18
*  along with this program; if not, write to the Free Software Foundation,
ds@1952
    19
*  Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
ds@1952
    20
*
ds@1952
    21
*  In addition, as a special exception, the author gives permission to
ds@1952
    22
*  link the code of this program with the Half-Life Game Engine ("HL
ds@1952
    23
*  Engine") and Modified Game Libraries ("MODs") developed by Valve,
ds@1952
    24
*  L.L.C ("Valve"). You must obey the GNU General Public License in all
ds@1952
    25
*  respects for all of the code used other than the HL Engine and MODs
ds@1952
    26
*  from Valve. If you modify this file, you may extend this exception
ds@1952
    27
*  to your version of the file, but you are not obligated to do so. If
ds@1952
    28
*  you do not wish to do so, delete this exception statement from your
ds@1952
    29
*  version.
ds@1952
    30
*)
ds@1952
    31
ds@1952
    32
unit uFunc;
ds@1952
    33
ds@1952
    34
interface
ds@1952
    35
ds@1952
    36
uses
ds@1952
    37
  Windows, SysUtils, Classes, Math, IniFiles;
ds@1952
    38
ds@1952
    39
resourcestring
ds@1952
    40
  COMPILER_EXE = 'spcomp.exe';
ds@1952
    41
ds@1952
    42
procedure AppExit;
ds@1952
    43
procedure CompilePlugin(const Name, OutputDir: String);
ds@1952
    44
function GetAgeFromDat(const FileName: String): Integer;
ds@1952
    45
procedure SetAgeToDat(const FileName: String; const Age: Integer);
ds@1952
    46
function GetConsoleOutput(const Command: String; var Output: TStringList): Boolean;
ds@1952
    47
ds@1952
    48
implementation
ds@1952
    49
ds@1952
    50
procedure AppExit;
ds@1952
    51
begin
ds@1952
    52
  WriteLn;
ds@1952
    53
  Write('Press enter to exit ...');
ds@1952
    54
  ReadLn;
ds@1952
    55
  Halt;
ds@1952
    56
end;
ds@1952
    57
ds@1952
    58
procedure CompilePlugin(const Name, OutputDir: String);
ds@1952
    59
var
ds@1952
    60
  Output: TStringList;
ds@1952
    61
  i: Word;
ds@1952
    62
  cStart,cEnd: Longword;
ds@1952
    63
  FileName, FilePath, Compiled: String;
ds@1952
    64
begin
ds@1952
    65
  FileName := ExtractFileName(Name);
ds@1952
    66
  FilePath := ExtractFilePath(Name);
ds@1952
    67
  if (OutputDir = '') then
ds@1952
    68
    Compiled := FilePath+'compiled\'+ChangeFileExt(Filename,'.smx')
ds@1952
    69
  else
ds@1952
    70
    Compiled := OutputDir+ChangeFileExt(Filename,'.smx');
ds@1952
    71
ds@1952
    72
  if (FilePath='') then
ds@1952
    73
    FilePath := ExtractFilePath(ParamStr(0));
ds@1952
    74
ds@1952
    75
  WriteLn;
ds@1952
    76
  WriteLn('//// '+ExtractFileName(FileName));
ds@1952
    77
ds@1952
    78
  if FileExists(Compiled) and ( GetAgeFromDat(Name)=FileAge(Name) ) then
ds@1952
    79
  begin
ds@1952
    80
    WriteLn('// Already compiled.');
ds@1952
    81
    WriteLn('// ----------------------------------------');
ds@1952
    82
    Exit;
ds@1952
    83
  end;
ds@1952
    84
ds@1952
    85
  Output := TStringList.Create;
ds@1952
    86
ds@1952
    87
  try
ds@1952
    88
    cStart := GetTickCount;
ds@1952
    89
    if not GetConsoleOutput(ExtractFilePath(ParamStr(0))+COMPILER_EXE+' "'+Name+'" "-o'+Compiled+'"',Output) then
ds@1952
    90
    begin
ds@1952
    91
      WriteLn('// Internal error.');
ds@1952
    92
      AppExit;
ds@1952
    93
    end;
ds@1952
    94
    cEnd := GetTickCount;
ds@1952
    95
ds@1952
    96
    for i := 3 to (Output.Count-1) do
ds@1952
    97
    begin
ds@1952
    98
      WriteLn('// '+Output.Strings[i]);
ds@1952
    99
    end;
ds@1952
   100
ds@1952
   101
    WriteLn('//');
ds@1952
   102
    WriteLn('// Compilation Time: '+FloatToStr(SimpleRoundTo((cEnd-cStart) / 1000,-2))+' sec');
ds@1952
   103
    WriteLn('// ----------------------------------------');
ds@1952
   104
    Output.Free;
ds@1952
   105
  except
ds@1952
   106
    WriteLn('// Internal error.');
ds@1952
   107
    AppExit;
ds@1952
   108
  end;
ds@1952
   109
ds@1952
   110
  SetAgeToDat(Name,FileAge(Name));
ds@1952
   111
end;
ds@1952
   112
ds@1952
   113
function GetAgeFromDat(const FileName: String): Integer;
ds@1952
   114
var
ds@1952
   115
  Ini: TIniFile;
ds@1952
   116
begin
ds@1952
   117
  Ini := TIniFile.Create(ExtractFilePath(ParamStr(0))+'compile.dat');
ds@1952
   118
  Result := Ini.ReadInteger(FileName,'Age',-1);
ds@1952
   119
  Ini.Free;
ds@1952
   120
end;
ds@1952
   121
ds@1952
   122
procedure SetAgeToDat(const FileName: String; const Age: Integer);
ds@1952
   123
var
ds@1952
   124
  Ini: TIniFile;
ds@1952
   125
begin
ds@1952
   126
  Ini := TIniFile.Create(ExtractFilePath(ParamStr(0))+'compile.dat');
ds@1952
   127
  Ini.WriteInteger(FileName,'Age',Age);
ds@1952
   128
  Ini.UpdateFile;
ds@1952
   129
  Ini.Free;
ds@1952
   130
  SetFileAttributes(PChar(ExtractFilePath(ParamStr(0))+'compile.dat'), faHidden);
ds@1952
   131
end;
ds@1952
   132
ds@1952
   133
function GetConsoleOutput(const Command: String; var Output: TStringList): Boolean;
ds@1952
   134
var
ds@1952
   135
  StartupInfo: TStartupInfo;
ds@1952
   136
  ProcessInfo: TProcessInformation;
ds@1952
   137
  SecurityAttr: TSecurityAttributes;
ds@1952
   138
  PipeOutputRead: THandle;
ds@1952
   139
  PipeOutputWrite: THandle;
ds@1952
   140
  PipeErrorsRead: THandle;
ds@1952
   141
  PipeErrorsWrite: THandle;
ds@1952
   142
  Succeed: Boolean;
ds@1952
   143
  Buffer: array [0..255] of Char;
ds@1952
   144
  NumberOfBytesRead: DWORD;
ds@1952
   145
  Stream: TMemoryStream;
ds@1952
   146
  Errors: String;
ds@1952
   147
begin
ds@1952
   148
  FillChar(ProcessInfo, SizeOf(TProcessInformation), 0);
ds@1952
   149
  FillChar(SecurityAttr, SizeOf(TSecurityAttributes), 0);
ds@1952
   150
ds@1952
   151
  SecurityAttr.nLength := SizeOf(SecurityAttr);
ds@1952
   152
  SecurityAttr.bInheritHandle := True;
ds@1952
   153
  SecurityAttr.lpSecurityDescriptor := nil;
ds@1952
   154
ds@1952
   155
  CreatePipe(PipeOutputRead, PipeOutputWrite, @SecurityAttr, 0);
ds@1952
   156
  CreatePipe(PipeErrorsRead, PipeErrorsWrite, @SecurityAttr, 0);
ds@1952
   157
ds@1952
   158
  FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
ds@1952
   159
  StartupInfo.cb:=SizeOf(StartupInfo);
ds@1952
   160
  StartupInfo.hStdInput := 0;
ds@1952
   161
  StartupInfo.hStdOutput := PipeOutputWrite;
ds@1952
   162
  StartupInfo.hStdError := PipeErrorsWrite;
ds@1952
   163
  StartupInfo.wShowWindow := SW_HIDE;
ds@1952
   164
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
ds@1952
   165
ds@1952
   166
  if  CreateProcess(nil, PChar(command), nil, nil, true, CREATE_DEFAULT_ERROR_MODE or CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo) then begin
ds@1952
   167
    Result := True;
ds@1952
   168
    CloseHandle(PipeOutputWrite);
ds@1952
   169
    CloseHandle(PipeErrorsWrite);
ds@1952
   170
ds@1952
   171
    Stream := TMemoryStream.Create;
ds@1952
   172
    try
ds@1952
   173
      while True do begin
ds@1952
   174
        Succeed := ReadFile(PipeOutputRead, Buffer, 255, NumberOfBytesRead, nil);
ds@1952
   175
        if not Succeed then Break;
ds@1952
   176
        Stream.Write(Buffer, NumberOfBytesRead);
ds@1952
   177
      end;
ds@1952
   178
    finally
ds@1952
   179
      // nothing
ds@1952
   180
    end;
ds@1952
   181
    Stream.Position := 0;
ds@1952
   182
    Output.LoadFromStream(Stream);
ds@1952
   183
    Stream.Free;
ds@1952
   184
    CloseHandle(PipeOutputRead);
ds@1952
   185
ds@1952
   186
    Errors := '';
ds@1952
   187
    try
ds@1952
   188
      while True do
ds@1952
   189
      begin
ds@1952
   190
        Succeed := ReadFile(PipeErrorsRead, Buffer, 255, NumberOfBytesRead, nil);
ds@1952
   191
        if not Succeed then Break;
ds@1952
   192
        Errors := Errors + Copy(Buffer, 1, NumberOfBytesRead);
ds@1952
   193
      end;
ds@1952
   194
    finally
ds@1952
   195
      // nothing
ds@1952
   196
    end;
ds@1952
   197
    CloseHandle(PipeErrorsRead);
ds@1952
   198
ds@1952
   199
    WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
ds@1952
   200
    CloseHandle(ProcessInfo.hProcess);
ds@1952
   201
  end
ds@1952
   202
  else
ds@1952
   203
  begin
ds@1952
   204
    Result := False;
ds@1952
   205
    CloseHandle(PipeOutputRead);
ds@1952
   206
    CloseHandle(PipeOutputWrite);
ds@1952
   207
    CloseHandle(PipeErrorsRead);
ds@1952
   208
    CloseHandle(PipeErrorsWrite);
ds@1952
   209
  end;
ds@1952
   210
  // error management
ds@1952
   211
  if (Errors <> '') then begin
ds@1952
   212
    if (Output.Count > 1) then begin
ds@1952
   213
      if (Trim(Output[Output.Count -2]) = '') then
ds@1952
   214
        Output.Strings[Output.Count -2] := TrimRight(Errors)
ds@1952
   215
      else
ds@1952
   216
        Output.Insert(Output.Count -1, TrimRight(Errors));
ds@1952
   217
    end
ds@1952
   218
    else
ds@1952
   219
      Output.Add(Errors);
ds@1952
   220
    Output.Text := Output.Text; // pseudo-rearrangement
ds@1952
   221
  end;
ds@1952
   222
end;
ds@1952
   223
ds@1952
   224
end.