Added AMXX-Studio to CVS
This commit is contained in:
Christian Hammacher
300
editor/studio/UnitCompile.pas
Executable file
300
editor/studio/UnitCompile.pas
Executable file
@ -0,0 +1,300 @@
|
||||
unit UnitCompile;
|
||||
|
||||
interface
|
||||
|
||||
uses SysUtils, Classes, Windows, Forms, Controls, ShellAPI, Messages, IdFTP,
|
||||
IdFTPCommon;
|
||||
|
||||
type TPAWNCompileThread = class(TThread)
|
||||
protected
|
||||
Stream: TStringStream;
|
||||
|
||||
Output: TStringList;
|
||||
Finished: Boolean;
|
||||
procedure Execute; override;
|
||||
procedure ProcessItem(eLineStr: String);
|
||||
procedure AddOutput;
|
||||
procedure StartHL;
|
||||
procedure Upload;
|
||||
public
|
||||
FileName: string;
|
||||
Compiler: string;
|
||||
Args: string;
|
||||
Target: string;
|
||||
Flags: Integer;
|
||||
end;
|
||||
|
||||
function DoCompilePAWN(eFlags: Integer): Boolean;
|
||||
|
||||
implementation
|
||||
|
||||
uses UnitfrmSettings, UnitLanguages, UnitMainTools, UnitfrmMain,
|
||||
UnitCodeUtils, UnitPlugins;
|
||||
|
||||
function DoCompilePAWN(eFlags: Integer): Boolean;
|
||||
var eFile: string;
|
||||
begin
|
||||
Result := False;
|
||||
if not FileExists(frmSettings.txtPAWNCompilerPath.Text) then begin
|
||||
MessageBox(frmMain.Handle, PChar(lPAWNCompilerNotFound), PChar(Application.Title), MB_ICONERROR);
|
||||
exit;
|
||||
end;
|
||||
|
||||
Screen.Cursor := crHourGlass;
|
||||
if (ActiveDoc.Untitled) then
|
||||
eFile := ExtractFilePath(ParamStr(0)) + 'Untitled.sma'
|
||||
else
|
||||
eFile := ActiveDoc.FileName;
|
||||
frmMain.sciEditor.Lines.SaveToFile(eFile);
|
||||
|
||||
if Plugin_VisibleControlChange(CTRL_OUTPUT, True) then begin
|
||||
frmMain.lstOutput.Clear;
|
||||
frmMain.splOutput.Show;
|
||||
frmMain.lstOutput.Show;
|
||||
Plugin_VisibleControlChange(CTRL_OUTPUT, True);
|
||||
end;
|
||||
|
||||
with TPawnCompileThread.Create(True) do begin
|
||||
FileName := eFile;
|
||||
Compiler := frmSettings.txtPAWNCompilerPath.Text;
|
||||
if DirectoryExists(frmSettings.txtPAWNOutput.Text) then
|
||||
Target := IncludeTrailingPathDelimiter(frmSettings.txtPAWNOutput.Text) + ChangeFileExt(ExtractFileName(ActiveDoc.FileName), '.amxx')
|
||||
else
|
||||
Target := ChangeFileExt(eFile, '.amxx');
|
||||
|
||||
Args := frmSettings.txtPAWNArgs.Text;
|
||||
if Args <> '' then
|
||||
Args := Args + #32;
|
||||
Flags := eFlags;
|
||||
|
||||
Resume;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TPAWNCompileThread }
|
||||
|
||||
procedure TPAWNCompileThread.ProcessItem(eLineStr: String);
|
||||
var eLine: Integer;
|
||||
eTemp: String;
|
||||
begin
|
||||
eLine := -1;
|
||||
if Pos(LowerCase(FileName), LowerCase(eLineStr)) = 1 then begin
|
||||
Delete(eLineStr, 1, Length(FileName));
|
||||
if IsNumeric(Between(eLineStr, '(', ')')) then
|
||||
eLine := StrToInt(Between(eLineStr, '(', ')'));
|
||||
|
||||
eTemp := Between(eLineStr, ':', ':');
|
||||
|
||||
Delete(eLineStr, 1, Pos(':', eLineStr) +1);
|
||||
Delete(eLineStr, 1, Pos(':', eLineStr) +1);
|
||||
if eLineStr <> '' then
|
||||
eLineStr[1] := UpperCase(eLineStr[1])[1];
|
||||
if Pos('error', eTemp) <> 0 then
|
||||
eLineStr := Format(lError, [Trim(eLineStr), eLine])
|
||||
else if Pos('warning', eTemp) <> 0 then
|
||||
eLineStr := Format(lWarning, [Trim(eLineStr), eLine])
|
||||
else
|
||||
eLineStr := Format(lOther, [Trim(eLineStr), eLine]);
|
||||
end;
|
||||
|
||||
if frmMain.lstOutput.ItemIndex = -1 then begin
|
||||
if Pos('error', eTemp) <> 0 then begin
|
||||
frmMain.lstOutput.SetFocus;
|
||||
frmMain.lstOutput.ItemIndex := frmMain.lstOutput.Items.Add(eLineStr);
|
||||
frmMain.SetErrorLine(eLine);
|
||||
end
|
||||
else if eLineStr = 'Done.' then begin
|
||||
if (DirectoryExists(GetAMXXDir(True) + 'plugins\')) and (GetAMXXDir(True) <> '') then begin
|
||||
if LowerCase(IncludeTrailingPathDelimiter(frmSettings.txtPAWNOutput.Text)) <> LowerCase(GetAMXXDir(True) + 'plugins\') then begin
|
||||
if FileExists(GetAMXXDir(True) + 'plugins\' + ChangeFileExt(ExtractFileName(ActiveDoc.FileName), '.amxx')) then
|
||||
DeleteFile(PChar(GetAMXXDir(True) + 'plugins\' + ChangeFileExt(ExtractFileName(ActiveDoc.FileName), '.amxx')));
|
||||
if frmSettings.txtPAWNOutput.Text = '' then
|
||||
CopyFile(PChar(ChangeFileExt(ActiveDoc.FileName, '.amxx')), PChar(GetAMXXDir(True) + 'plugins\' + ChangeFileExt(ExtractFileName(ActiveDoc.FileName), '.amxx')), False)
|
||||
else
|
||||
CopyFile(PChar(frmSettings.txtPAWNOutput.Text + ChangeFileExt(ExtractFileName(ActiveDoc.FileName), '.amxx')), PChar(GetAMXXDir(True) + 'plugins\' + ChangeFileExt(ExtractFileName(ActiveDoc.FileName), '.amxx')), False);
|
||||
frmMain.lstOutput.Items.Add('Copied output file to: ' + GetAMXXDir(True)+ 'plugins\');
|
||||
end;
|
||||
end;
|
||||
|
||||
if Flags = COMP_STARTHL then // Start HL
|
||||
Synchronize(StartHL)
|
||||
else if Flags = COMP_UPLOAD then
|
||||
Synchronize(Upload)
|
||||
else begin
|
||||
frmMain.lstOutput.ItemIndex := frmMain.lstOutput.Items.Add('Done.');
|
||||
frmMain.lstOutput.Perform(WM_VSCROLL, SB_BOTTOM, 0);
|
||||
end;
|
||||
Plugin_Compile(Flags, GetCurrLang.Name, ActiveDoc.FileName, False);
|
||||
end
|
||||
else begin
|
||||
frmMain.lstOutput.Items.Add(eLineStr);
|
||||
frmMain.lstOutput.Perform(WM_VSCROLL, SB_BOTTOM, 0);
|
||||
end;
|
||||
end
|
||||
else
|
||||
frmMain.lstOutput.Items.Add(eLineStr);
|
||||
end;
|
||||
|
||||
procedure TPAWNCompileThread.AddOutput;
|
||||
var i, eIndex: integer;
|
||||
begin
|
||||
if Output.Count > 1 then begin
|
||||
eIndex := frmMain.lstOutput.ItemIndex;
|
||||
frmMain.lstOutput.Items.BeginUpdate;
|
||||
frmMain.lstOutput.Items.Clear;
|
||||
if Finished then begin
|
||||
for i := 0 to Output.Count -1 do
|
||||
ProcessItem(Output[i]);
|
||||
end
|
||||
else begin
|
||||
for i := 0 to Output.Count -2 do
|
||||
ProcessItem(Output[i]);
|
||||
end;
|
||||
frmMain.lstOutput.Items.EndUpdate;
|
||||
frmMain.lstOutput.ItemIndex := eIndex;
|
||||
frmMain.Repaint;
|
||||
Application.ProcessMessages;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPAWNCompileThread.Execute;
|
||||
var StartupInfo: TStartupInfo;
|
||||
ProcessInfo: TProcessInformation;
|
||||
SecurityAttr: TSecurityAttributes;
|
||||
PipeOutputRead: THandle;
|
||||
PipeOutputWrite: THandle;
|
||||
PipeErrorsRead: THandle;
|
||||
PipeErrorsWrite: THandle;
|
||||
Succeed: Boolean;
|
||||
Buffer: array[0..255] of Char;
|
||||
NumberOfBytesRead: DWORD;
|
||||
begin
|
||||
Output := TStringList.Create;
|
||||
FillChar(ProcessInfo, SizeOf(TProcessInformation), 0);
|
||||
FillChar(SecurityAttr, SizeOf(TSecurityAttributes), 0);
|
||||
SecurityAttr.nLength := SizeOf(SecurityAttr);
|
||||
SecurityAttr.bInheritHandle := True;
|
||||
SecurityAttr.lpSecurityDescriptor := nil;
|
||||
CreatePipe(PipeOutputRead, PipeOutputWrite, @SecurityAttr, 0);
|
||||
CreatePipe(PipeErrorsRead, PipeErrorsWrite, @SecurityAttr, 0);
|
||||
FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
|
||||
StartupInfo.cb := SizeOf(StartupInfo);
|
||||
StartupInfo.hStdInput := 0;
|
||||
StartupInfo.hStdOutput := PipeOutputWrite;
|
||||
StartupInfo.hStdError := PipeErrorsWrite;
|
||||
StartupInfo.wShowWindow := SW_HIDE;
|
||||
StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
|
||||
if CreateProcess(nil, PChar(Compiler + ' "' + FileName + '" ' + Args + '"-o' + Target + '"'), nil, nil, True, CREATE_DEFAULT_ERROR_MODE or CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo) then begin
|
||||
CloseHandle(PipeOutputWrite);
|
||||
CloseHandle(PipeErrorsWrite);
|
||||
|
||||
Stream := TStringStream.Create('');
|
||||
try
|
||||
Finished := False;
|
||||
while True do begin
|
||||
Succeed := ReadFile(PipeOutputRead, Buffer, 255, NumberOfBytesRead, nil);
|
||||
if not Succeed then break;
|
||||
Stream.Write(Buffer, NumberOfBytesRead);
|
||||
Output.Text := Stream.DataString;
|
||||
Synchronize(AddOutput);
|
||||
end;
|
||||
Finished := True;
|
||||
Synchronize(AddOutput);
|
||||
finally
|
||||
Stream.Free;
|
||||
end;
|
||||
CloseHandle(PipeOutputRead);
|
||||
try
|
||||
while True do begin
|
||||
Succeed := ReadFile(PipeErrorsRead, Buffer, 255, NumberOfBytesRead, nil);
|
||||
if not Succeed then Break;
|
||||
{ and here the errors }
|
||||
end;
|
||||
finally
|
||||
end;
|
||||
CloseHandle(PipeErrorsRead);
|
||||
WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
|
||||
CloseHandle(ProcessInfo.hProcess);
|
||||
end
|
||||
else begin
|
||||
CloseHandle(PipeOutputRead);
|
||||
CloseHandle(PipeOutputWrite);
|
||||
CloseHandle(PipeErrorsRead);
|
||||
CloseHandle(PipeErrorsWrite);
|
||||
end;
|
||||
Screen.Cursor := crDefault;
|
||||
Output.Free;
|
||||
end;
|
||||
|
||||
procedure TPAWNCompileThread.StartHL;
|
||||
begin
|
||||
frmMain.lstOutput.ItemIndex := frmMain.lstOutput.Items.Add('Done.');
|
||||
frmMain.lstOutput.Items.Add('');
|
||||
frmMain.lstOutput.ItemIndex := frmMain.lstOutput.Items.Add(lStartingHalfLife);
|
||||
if (FileExists(frmSettings.txtHLExec.Text)) and (frmSettings.txtHLExec.Text <> '') then begin
|
||||
ShellExecute(frmMain.Handle, 'open', PChar(frmSettings.txtHLExec.Text), PChar(frmSettings.txtCustomParameters.Text), PChar(ExtractFilePath(frmSettings.txtHLExec.Text)), SW_SHOW);
|
||||
frmMain.lstOutput.ItemIndex := frmMain.lstOutput.Items.Add('Done.');
|
||||
end
|
||||
else begin
|
||||
frmMain.lstOutput.ItemIndex := frmMain.lstOutput.Items.Add(lHLNotFound);
|
||||
frmMain.lstOutput.ItemIndex := frmMain.lstOutput.Items.Add(lCheckSettingsTryAgain);
|
||||
MessageBeep(MB_ICONWARNING);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPAWNCompileThread.Upload;
|
||||
procedure AddOutput(eItem: String);
|
||||
var eAddedIndex: Integer;
|
||||
begin
|
||||
eAddedIndex := frmMain.lstOutput.Items.Add(eItem);
|
||||
|
||||
frmMain.lstOutput.ItemIndex := eAddedIndex;
|
||||
repeat
|
||||
Delay(50);
|
||||
frmMain.lstOutput.Repaint;
|
||||
until frmMain.lstOutput.ItemIndex = eAddedIndex;
|
||||
end;
|
||||
|
||||
begin
|
||||
AddOutput('Done.');
|
||||
if frmMain.IdFTP.Connected then
|
||||
frmMain.IdFTP.Disconnect;
|
||||
|
||||
AddOutput('');
|
||||
AddOutput(lConnecting);
|
||||
|
||||
if TryConnect = 0 then begin
|
||||
AddOutput(lChangingDir);
|
||||
|
||||
try
|
||||
frmMain.IdFTP.ChangeDir(frmSettings.txtDefaultDir.Text + 'plugins/');
|
||||
AddOutput(lUploadingFile);
|
||||
except
|
||||
MessageBox(frmMain.Handle, PChar(lInvalidDirectory), PChar(Application.Title), MB_ICONERROR);
|
||||
AddOutput(lUploadFailed);
|
||||
|
||||
if frmMain.IdFTP.Connected then
|
||||
frmMain.IdFTP.Disconnect;
|
||||
exit;
|
||||
end;
|
||||
|
||||
try
|
||||
frmMain.IdFTP.TransferType := ftBinary;
|
||||
frmMain.IdFTP.Put(Target, ExtractFileName(Target));
|
||||
AddOutput(lDone);
|
||||
except
|
||||
on E: Exception do begin
|
||||
MessageBox(frmMain.Handle, PChar(lErrorUpload + #13 + E.Message), PChar(Application.Title), MB_ICONERROR);
|
||||
AddOutput(lUploadFailed);
|
||||
end;
|
||||
end;
|
||||
|
||||
if frmMain.IdFTP.Connected then
|
||||
frmMain.IdFTP.Disconnect;
|
||||
end
|
||||
else
|
||||
AddOutput(lUploadFailed);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user