Backups/SA-MP
1
0
Fork 0
mirror of https://github.com/dashr9230/SA-MP.git synced 2024-12-23 06:57:31 +08:00
Code Issues Actions Packages Projects Releases Wiki Activity
5467762720
SA-MP/exgui/Main.pas

2290 lines
66 KiB
ObjectPascal
Raw Blame History

unit Main;
interface
uses
Windows, Messages, Forms, SysUtils, Registry, WinSock, ComObj, ShellAPI, ShlObj, hh,
FindSort, Dialogs, IdHTTP, MMSystem, ExtCtrls, XPMan, ImgList, Controls,
Menus, ComCtrls, StdCtrls, TeEngine, Series, TeeProcs, Chart, Tabs, Graphics,
GIFImage, ToolWin, Classes, TlHelp32, ClipBrd, ActiveX;
{$L EliRT.obj}
function RT_GetVersion(pReserved:Pointer): LongWord; stdcall; external;
function xVirtualAllocEx(hProcess: LongWord; lpAddress: Pointer; dwSize: LongWord; flAllocationType: LongWord; flProtect: LongWord): Pointer; stdcall; external;
function xCreateRemoteThread(hProcess :LongWord; lpThreadAttributes :Pointer; dwStackSize: LongWord; lpStartAddress: Pointer; lpParameter: Pointer; dwCreationFlags: LongWord; var lpThreadId: Cardinal): LongWord; stdcall; external;
const
WM_RECV = WM_USER+1;
type
TfmMain = class(TForm)
sbMain: TStatusBar;
mmMain: TMainMenu;
miFile: TMenuItem;
miExportFavoritesList: TMenuItem;
N1: TMenuItem;
miExit: TMenuItem;
miServers: TMenuItem;
miAddServer: TMenuItem;
miHelp: TMenuItem;
miAbout: TMenuItem;
tbMain: TToolBar;
pmServers: TPopupMenu;
tsServerLists: TTabSet;
miTools: TMenuItem;
ilMain: TImageList;
tbSettings: TToolButton;
tbCopyServerInfo: TToolButton;
tbMasterServerUpdate: TToolButton;
tbAbout: TToolButton;
tbHelp: TToolButton;
tbConnect: TToolButton;
tbRefreshServer: TToolButton;
tbAddServer: TToolButton;
tbDeleteServer: TToolButton;
tbServerProperties: TToolButton;
XPManifest: TXPManifest;
pnBreakable: TPanel;
gbFilter: TGroupBox;
edFilterMode: TLabeledEdit;
edFilterMap: TLabeledEdit;
cbFilterEmpty: TCheckBox;
cbFilterPassworded: TCheckBox;
cbFilterFull: TCheckBox;
gbInfo: TGroupBox;
tbSpacer1: TToolButton;
tbSpacer2: TToolButton;
tbSpacer4: TToolButton;
tbSpacer5: TToolButton;
tbSpacer3: TToolButton;
miConnect: TMenuItem;
N2: TMenuItem;
miDeleteServer: TMenuItem;
miRefreshServer: TMenuItem;
N3: TMenuItem;
miMasterServerUpdate: TMenuItem;
N4: TMenuItem;
miCopyServerInfo: TMenuItem;
miServerProperties: TMenuItem;
miSettings: TMenuItem;
miHelpTopics: TMenuItem;
N6: TMenuItem;
miImportFavoritesList: TMenuItem;
piConnect: TMenuItem;
N7: TMenuItem;
piDeleteServer: TMenuItem;
piRefreshServer: TMenuItem;
N9: TMenuItem;
piCopyServerInfo: TMenuItem;
piServerProperties: TMenuItem;
pnLine: TPanel;
lbSIAddressLab: TLabel;
lbSIModeLab: TLabel;
lbSIMapLab: TLabel;
lbSIPlayersLab: TLabel;
lbSIPingLab: TLabel;
lbSIPing: TLabel;
lbSIPlayers: TLabel;
lbSIMap: TLabel;
lbSIMode: TLabel;
edSIAddress: TEdit;
pnSIDivider: TPanel;
chSIPingChart: TChart;
chSIPingLineChart: TFastLineSeries;
tmSIPingUpdate: TTimer;
miView: TMenuItem;
miFilterServerInfo: TMenuItem;
N10: TMenuItem;
miStatusBar: TMenuItem;
pmCopy: TPopupMenu;
piCopy: TMenuItem;
pnRight: TPanel;
pnPlayers: TPanel;
lbPlayers: TListBox;
hcPlayers: THeaderControl;
pnRules: TPanel;
lbRules: TListBox;
hcRules: THeaderControl;
pnMain: TPanel;
hcServers: THeaderControl;
lbServers: TListBox;
spRight: TSplitter;
Splitter1: TSplitter;
lblPlayerName: TLabel;
N11: TMenuItem;
miSamp: TMenuItem;
tmrQueryQueueProcess: TTimer;
edName: TEdit;
label_url: TLabel;
AddtoFavorites1: TMenuItem;
imLogo: TImage;
imPadlock: TImage;
imPadlocked: TImage;
imDownArrow: TImage;
imUpArrow: TImage;
tmrServerListUpdate: TTimer;
ToolButton1: TToolButton;
function GetToken(TokenData: String; ItemIndex: Integer; TokenDelimiter: String): String;
function GetClipBoardStr: String;
procedure SetClipBoardStr(Str: String);
procedure GetGTAExe(Owner: HWND);
procedure FormCreate(Sender: TObject);
procedure lbServersDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
procedure hcServersSectionResize(HeaderControl: THeaderControl;
Section: THeaderSection);
procedure tbMainResize(Sender: TObject);
procedure hcServersSectionClick(HeaderControl: THeaderControl;
Section: THeaderSection);
procedure pnBreakableResize(Sender: TObject);
procedure hcServersDrawSection(HeaderControl: THeaderControl;
Section: THeaderSection; const Rect: TRect; Pressed: Boolean);
procedure tmSIPingUpdateTimer(Sender: TObject);
procedure lbServersClick(Sender: TObject);
procedure FilterChange(Sender: TObject);
procedure UpdateServers;
procedure lbServersContextPopup(Sender: TObject; MousePos: TPoint;
var Handled: Boolean);
procedure AddServer(Server: String);
procedure ImportFavoritesClick(Sender: TObject);
procedure ImportFavorites(FileName: String; AddToFavs: Boolean);
procedure ExportFavoritesClick(Sender: TObject);
procedure ExportFavorites(FileName: String; ExportPasswords: Boolean);
procedure ExitClick(Sender: TObject);
procedure miViewClick(Sender: TObject);
procedure ToggleFilterServerInfo(Sender: TObject);
procedure ToggleStatusBar(Sender: TObject);
procedure ConnectClick(Sender: TObject);
procedure AddServerClick(Sender: TObject);
procedure DeleteServerClick(Sender: TObject);
procedure RefreshServerClick(Sender: TObject);
procedure MasterServerUpdateClick(Sender: TObject);
procedure CopyServerInfoClick(Sender: TObject);
procedure ServerPropertiesClick(Sender: TObject);
procedure SettingsClick(Sender: TObject);
procedure RemoteConsoleClick(Sender: TObject);
procedure HelpTopicsClick(Sender: TObject);
procedure AboutClick(Sender: TObject);
procedure tsServerListsChange(Sender: TObject; NewTab: Integer;
var AllowChange: Boolean);
procedure QueryServerInfoParse(SrcIP: String; SrcPort: Word; Buf: PAnsiChar; DataLen: Integer);
procedure QueryServerInfoError(SocketError: Integer);
procedure QueryServerInfo(Server: String; bPing: Boolean; bInfo: Boolean; bPlayers: Boolean; bRules: Boolean);
procedure ServerConnect(Server: String; Port: String; Password: String);
procedure piCopyClick(Sender: TObject);
procedure pmCopyPopup(Sender: TObject);
procedure lbPlayersDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
procedure hcPlayersSectionResize(HeaderControl: THeaderControl;
Section: THeaderSection);
procedure lbRulesDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
procedure hcRulesSectionResize(HeaderControl: THeaderControl;
Section: THeaderSection);
procedure sbMainDrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel;
const Rect: TRect);
procedure lbPlayersExit(Sender: TObject);
procedure lbRulesExit(Sender: TObject);
procedure WMRecv(var Message: TMessage); message WM_RECV;
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
function BrowseForFolder(Owner: HWND; var Directory: String; StartDir, Title: String): Boolean;
procedure miSampClick(Sender: TObject);
procedure tmrQueryQueueProcessTimer(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure tmServerListUpdate(Sender: TObject);
procedure label_urlClick(Sender: TObject);
procedure imLogoClick(Sender: TObject);
procedure CreateFASTDesktoplink1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TPlayerInfo = record
Name: String;
Score: Integer;
end;
TRuleInfo = record
Rule: String;
Value: String;
end;
TServerInfo = record
Address: String;
DottedAddress: String;
HasAddress: Boolean;
Port: Integer;
Tag: Word;
HostName: String;
Passworded: Boolean;
Players: Integer;
MaxPlayers: Integer;
Ping: Integer;
Mode: String;
Map: String;
ServerPassword: String;
RconPassword: String;
aPlayers: Array of TPlayerInfo;
aRules: Array of TRuleInfo;
end;
TSortMode = (smHostName, smPlayers, smPing, smMode, smMap);
TSortDir = (sdUp, sdDown);
const
FavoritesFileVersion = 1;
var
fmMain: TfmMain;
Servers: Array of TServerInfo;
Filtered: Boolean = true;
SortMode: TSortMode = smHostName;
OldSortMode: TSortMode = smHostName;
SortDir: TSortDir = sdUp;
OldSortDir: TSortDir = sdUp;
QuerySocket: Integer;
FileTag: Array[0..3] of Char = ('S','A','M','P');
SelServer: Integer = -1;
PingCounter: Integer = 0;
MasterFile: Integer = 1;
gta_sa_exe: String;
QueryQueue: TStringList;
ServersTopIndex: Integer = -1;
byte_4ED6C4: Boolean = false;
dword_4EF08C: TStringList;
FavoritesChanged: Boolean;
implementation
uses
ImportFavorites, ExportFavorites, ServerProperties,
RconConfig, Settings, About, Rcon, MasterUpdate,
unit_webrunform;
{$R *.dfm}
procedure sub_4E1CEC();
begin
if byte_4ED6C4 <> true then begin
CreateMutex(nil, true, 'kyeman and spookie woz ''ere, innit.');
if GetLastError = ERROR_ALREADY_EXISTS then begin
MessageBox(0, 'SA:MP is already running.'#10#10'You can only run one instance at a time.', 'SA:MP Error', MB_ICONERROR);
ExitProcess(0);
end;
byte_4ED6C4:= true;
end;
end;
function sub_4E1DA8(): String;
var
szPath: Array[0..MAX_PATH] Of Char;
begin
if SHGetSpecialFolderPath(0, szPath, CSIDL_PERSONAL, False) <> FALSE then
Result:= szPath + '\GTA San Andreas User Files\SAMP\'
else
Result:= '';
end;
procedure sub_4E1E6C(a1, a2: String);
var
v16: IUnknown;
v15: IShellLink;
v14: IPersistFile;
v13, v12: String;
v11: Array[0..264] Of Char;
szPath: Array[0..MAX_PATH] Of Char;
v10: WideString;
begin
v12:= Application.ExeName;
v16 := CreateComObject(CLSID_ShellLink);
v15 := v16 as IShellLink;
v14 := v16 as IPersistFile;
v15.SetPath(PChar(v12));
v15.SetWorkingDirectory(PChar(ExtractFilePath(v12)));
v15.SetArguments(PChar(a1));
SHGetSpecialFolderPath(0, szPath, CSIDL_DESKTOP, False);
v13:= szPath + String('\') + a2 + '.lnk';
v14.Save(PWideChar(v13), false);
end;
function CompareHostName(a, b: Pointer): Integer;
begin
Result:= CompareText(TServerInfo(a^).HostName, TServerInfo(b^).HostName);
end;
function ComparePlayers(a, b: Pointer): Integer;
begin
if TServerInfo(a^).Players > TServerInfo(b^).Players then
Result:= 1
else if TServerInfo(a^).Players = TServerInfo(b^).Players then
Result:= 0
else
Result:= -1;
end;
function ComparePing(a, b: Pointer): Integer;
begin
if TServerInfo(a^).Ping > TServerInfo(b^).Ping then
Result:= 1
else if TServerInfo(a^).Ping = TServerInfo(b^).Ping then
Result:= 0
else
Result:= -1;
end;
function CompareMode(a, b: Pointer): Integer;
begin
Result:= CompareText(TServerInfo(a^).Mode, TServerInfo(b^).Mode);
end;
function CompareMap(a, b: Pointer): Integer;
begin
Result:= CompareText(TServerInfo(a^).Map, TServerInfo(b^).Map);
end;
procedure sub_4E220C(a1: String);
var
v10: String;
v9: Integer;
function sub_4E2140(a1, a2: string): Integer;
var
v13: Integer;
begin
Result:= 0;
for v13:= (Length(a2) - Length(a1) + 1) downto 1 do begin
if Copy(a2, v13, Length(a1)) = a1 then begin
Result:= v13;
Exit;
end;
end;
end;
begin
if (Copy(a1, 2, 1) <> ':') then begin
if (Copy(a1, 3, 1) <> '\') then begin
if (Copy(a1, 1, 1) = '\') then begin
a1:= 'C:' + a1;
end else begin
a1:= 'C:\' + a1;
end;
end else begin
a1 := 'C:' + a1;
end;
end;
if not DirectoryExists(a1) then begin
v9:= sub_4E2140('\', a1);
v10:= Copy(a1, 1, v9 - 1);
if not DirectoryExists(v10) then
sub_4E220C(v10);
CreateDir(a1);
end;
end;
function TfmMain.GetToken(TokenData: String; ItemIndex: Integer; TokenDelimiter: String): String;
var
i, Len, DelimLen, TokenCount: Integer;
TokenString: String;
begin
TokenCount:= 0;
i:= 0;
TokenString:= '';
Len:= Length(TokenData);
DelimLen := Length(TokenDelimiter);
if (Len > 0) then begin
while i <= Len do begin
if (TokenCount = (ItemIndex - 1)) then begin
if (Copy(TokenData,i+1,DelimLen) = TokenDelimiter) then
break;
TokenString := TokenString + Copy(TokenData,i+1,1);
end;
if (Copy(TokenData,i+1,DelimLen) = TokenDelimiter) then begin
Inc(TokenCount);
Inc(i, DelimLen-1);
end;
Inc(i);
end;
end;
Result:= TokenString;
end;
function GetIPFromHost(const HostName: string): string;
type
TaPInAddr = array[0..10] of PInAddr;
PaPInAddr = ^TaPInAddr;
var
phe: PHostEnt;
pptr: PaPInAddr;
i: Integer;
GInitData: TWSAData;
begin
if dword_4EF08C.Values[HostName] <> '' then begin
Result := '';
Exit;
end;
WSAStartup($101, GInitData);
Result := '';
phe := GetHostByName(PChar(HostName));
if phe = nil then begin
Result:= '';
dword_4EF08C.Values[HostName]:= '1';
Exit;
end;
pPtr := PaPInAddr(phe^.h_addr_list);
i := 0;
while pPtr^[i] <> nil do
begin
Result := inet_ntoa(pptr^[i]^);
Inc(i);
end;
WSACleanup;
end;
function sub_4E2628(a1: TColor): TColor;
begin
Result:= a1;
if GetRValue(ColorToRGB(a1)) > 16 then begin
if GetGValue(ColorToRGB(a1)) > 16 then begin
if GetBValue(ColorToRGB(a1)) > 16 then begin
Result:= RGB(
GetRValue(ColorToRGB(a1))-16,
GetGValue(ColorToRGB(a1))-16,
GetBValue(ColorToRGB(a1))-16);
end;
end;
end;
end;
function TfmMain.GetClipBoardStr: String;
begin
Result:= Clipboard.AsText;
end;
procedure TfmMain.SetClipBoardStr(Str: String);
begin
Clipboard.AsText:= Str;
end;
procedure TfmMain.GetGTAExe(Owner: HWND);
var
Reg: TRegistry;
TmpStr, BrowseExe: String;
begin
Reg:= TRegistry.Create;
Reg.RootKey:= HKEY_CURRENT_USER;
Reg.OpenKey('SOFTWARE\Rockstar Games\GTA San Andreas\Installation', false);
if Reg.ValueExists('ExePath') then
TmpStr:= Reg.ReadString('ExePath')
else begin
Reg.RootKey:= HKEY_LOCAL_MACHINE;
Reg.OpenKey('SOFTWARE\Rockstar Games\GTA San Andreas\Installation', false);
if Reg.ValueExists('ExePath') then
TmpStr:= Reg.ReadString('ExePath');
end;
Reg.CloseKey;
TmpStr:= ExtractFilePath(Copy(TmpStr, 2, Length(TmpStr)-2));
if BrowseForFolder(Owner, BrowseExe, TmpStr, 'Please locate your GTA: San Andreas installtion...') then begin
gta_sa_exe:= BrowseExe + '\gta_sa.exe';
Reg.RootKey:= HKEY_CURRENT_USER;
Reg.OpenKey('SOFTWARE\SAMP', true);
Reg.WriteString('gta_sa_exe', gta_sa_exe);
Reg.CloseKey;
Reg.Free;
end;
end;
procedure TfmMain.FormCreate(Sender: TObject);
var
Dummy: Boolean;
WSData: WSADATA;
s_in: sockaddr_in;
Reg: TRegistry;
begin
dword_4EF08C:= TStringList.Create;
FavoritesChanged:= false;
Reg:= TRegistry.Create;
Reg.RootKey:= HKEY_CURRENT_USER;
Reg.OpenKey('SOFTWARE\SAMP', true);
if Reg.ValueExists('gta_sa_exe') then
gta_sa_exe:= Reg.ReadString('gta_sa_exe')
else
GetGTAExe(Handle);
if Reg.ValueExists('PlayerName') then
edName.Text:= Reg.ReadString('PlayerName');
Reg.CloseKey;
Reg.Free;
Randomize;
WSAStartup($0202, WSData);
QuerySocket:= Socket(PF_INET, SOCK_DGRAM, IPPROTO_IP);
ZeroMemory(@s_in, sizeof(s_in));
s_in.sin_addr.S_addr:= INADDR_ANY;
s_in.sin_family:= AF_INET;
s_in.sin_port:= 0;
bind(QuerySocket, s_in, sizeof(s_in));
WSAAsyncSelect(QuerySocket, Handle, WM_RECV, FD_READ);
QueryQueue:= TStringList.Create;
tmrQueryQueueProcess.Enabled:= true;
tmrServerListUpdate.Enabled:= true;
sub_4E220C(sub_4E1DA8);
if FileExists(sub_4E1DA8 + 'USERDATA.DAT') then
ImportFavorites(sub_4E1DA8 + 'USERDATA.DAT', false);
tsServerListsChange(Self, 0, Dummy);
lbServersClick(Self);
UpdateServers;
end;
procedure TfmMain.lbServersDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
i, Idx: Integer;
TempRect: TRect;
begin
with (Control as TListBox) do begin
Idx:= StrToIntDef(Items.Strings[Index], 0);
if Idx >= Length(Servers) then Exit;
Canvas.Pen.Color:= clBtnHighlight;
Canvas.Pen.Style:= psClear;
if odSelected in State then begin
Canvas.Font.Color:= clHighlightText;
Canvas.Brush.Color:= clHighlight;
end else begin
Canvas.Font.Color:= clWindowText;
if (Index mod 2) = 1 then
Canvas.Brush.Color:= clWindow
else
Canvas.Brush.Color:= sub_4E2628(clWindow);
end;
Inc(Rect.Right);
Canvas.Rectangle(Rect);
Dec(Rect.Right);
Canvas.Pen.Style:= psSolid;
Canvas.PenPos:= Point(Rect.Right, Rect.Bottom-1);
Canvas.LineTo(Rect.Left, Rect.Bottom-1);
for i:= 0 to 5 do begin
Canvas.PenPos:= Point(hcServers.Sections.Items[i].Right-1, Rect.Top);
Canvas.LineTo(hcServers.Sections.Items[i].Right-1, Rect.Bottom);
end;
if Servers[Idx].Passworded then
BitBlt(Canvas.Handle, 7, Rect.Top + 1, 13, 14, imPadlocked.Canvas.Handle, 0, 0, SRCCOPY)
else
BitBlt(Canvas.Handle, 7, Rect.Top + 1, 13, 14, imPadlock.Canvas.Handle, 0, 0, SRCCOPY);
TempRect:= Classes.Rect(hcServers.Sections.Items[1].Left + 2, Rect.Top + 2, hcServers.Sections.Items[1].Right - 2, Rect.Bottom - 2);
DrawText(Canvas.Handle, PChar(Servers[Idx].HostName), -1, TempRect, DT_LEFT);
TempRect:= Classes.Rect(hcServers.Sections.Items[2].Left + 2, Rect.Top + 2, hcServers.Sections.Items[2].Right - 2, Rect.Bottom - 2);
DrawText(Canvas.Handle, PChar(IntToStr(Servers[Idx].Players) + ' / ' + IntToStr(Servers[Idx].MaxPlayers)), -1, TempRect, DT_LEFT);
TempRect:= Classes.Rect(hcServers.Sections.Items[3].Left + 2, Rect.Top + 2, hcServers.Sections.Items[3].Right - 2, Rect.Bottom - 2);
if Servers[Idx].Ping = 9999 then
DrawText(Canvas.Handle, '-', -1, TempRect, DT_LEFT)
else
DrawText(Canvas.Handle, PChar(IntToStr(Servers[Idx].Ping)), -1, TempRect, DT_LEFT);
TempRect:= Classes.Rect(hcServers.Sections.Items[4].Left + 2, Rect.Top + 2, hcServers.Sections.Items[4].Right - 2, Rect.Bottom - 2);
DrawText(Canvas.Handle, PChar(Servers[Idx].Mode), -1, TempRect, DT_LEFT);
TempRect:= Classes.Rect(hcServers.Sections.Items[5].Left + 2, Rect.Top + 2, hcServers.Sections.Items[5].Right - 2, Rect.Bottom - 2);
DrawText(Canvas.Handle, PChar(Servers[Idx].Map), -1, TempRect, DT_LEFT);
end;
end;
procedure TfmMain.hcServersSectionResize(HeaderControl: THeaderControl;
Section: THeaderSection);
begin
lbServers.Repaint;
end;
procedure TfmMain.tbMainResize(Sender: TObject);
begin
ToolButton1.Width:= ((Sender as TToolBar).Width-ToolButton1.Left)-imLogo.Width;
imLogo.Repaint;
end;
procedure TfmMain.hcServersSectionClick(HeaderControl: THeaderControl;
Section: THeaderSection);
begin
case Section.Index of
1:
begin
if SortMode = smHostName then begin
if SortDir = sdUp then
SortDir:= sdDown
else
SortDir:= sdUp;
end else begin
SortMode:= smHostName;
SortDir:= sdUp;
end;
end;
2:
begin
if SortMode = smPlayers then begin
if SortDir = sdUp then
SortDir:= sdDown
else
SortDir:= sdUp;
end else begin
SortMode:= smPlayers;
SortDir:= sdDown;
end;
end;
3:
begin
if SortMode = smPing then begin
if SortDir = sdUp then
SortDir:= sdDown
else
SortDir:= sdUp;
end else begin
SortMode:= smPing;
SortDir:= sdUp;
end;
end;
4:
begin
if SortMode = smMode then begin
if SortDir = sdUp then
SortDir:= sdDown
else
SortDir:= sdUp;
end else begin
SortMode:= smMode;
SortDir:= sdUp;
end;
end;
5:
begin
if SortMode = smMap then begin
if SortDir = sdUp then
SortDir:= sdDown
else
SortDir:= sdUp;
end else begin
SortMode:= smMap;
SortDir:= sdUp;
end;
end;
end;
UpdateServers;
end;
procedure TfmMain.pnBreakableResize(Sender: TObject);
begin
gbInfo.Width:= pnBreakable.Width - gbFilter.Width + 1;
chSIPingChart.Width:= gbInfo.Width - 272;
if chSIPingChart.Width > 50 then
chSIPingChart.Visible:= true
else
chSIPingChart.Visible:= false;
end;
var
ReRender: Boolean;
procedure TfmMain.hcServersDrawSection(HeaderControl: THeaderControl;
Section: THeaderSection; const Rect: TRect; Pressed: Boolean);
var
DoIt: Boolean;
TempRect: TRect;
begin
DoIt:= false;
Inc(TempRect.Left, 2);
Inc(TempRect.Top, 2);
Dec(TempRect.Right, 2);
Dec(TempRect.Bottom, 2);
if (Section.Index = 1) and (SortMode = smHostName) then begin
DoIt:= true;
end else if (Section.Index = 2) and (SortMode = smPlayers) then begin
DoIt:= true;
end else if (Section.Index = 3) and (SortMode = smPing) then begin
DoIt:= true;
end else if (Section.Index = 4) and (SortMode = smMode) then begin
DoIt:= true;
end else if (Section.Index = 5) and (SortMode = smMap) then begin
DoIt:= true;
end;
TempRect:= Rect;
Inc(TempRect.Left, 2);
Inc(TempRect.Top, 1);
if DoIt then begin
if SortDir = sdDown then
BitBlt(HeaderControl.Canvas.Handle, Rect.Left + 2, Rect.Top + 2, 9, 12, imDownArrow.Canvas.Handle, 0, 0, SRCCOPY)
else
BitBlt(HeaderControl.Canvas.Handle, Rect.Left + 2, Rect.Top + 2, 9, 12, imUpArrow.Canvas.Handle, 0, 0, SRCCOPY);
Inc(TempRect.Left, 10);
end;
DrawText(HeaderControl.Canvas.Handle, PChar(Section.Text), -1, TempRect, DT_LEFT);
if not ReRender then begin
ReRender:= true;
HeaderControl.Repaint;
ReRender:= false;
end;
end;
procedure TfmMain.tmServerListUpdate(Sender: TObject);
begin
if QueryQueue.Count > 0 then
UpdateServers;
lbPlayers.Invalidate;
lbRules.Invalidate;
end;
procedure TfmMain.tmSIPingUpdateTimer(Sender: TObject);
var
Idx: Integer;
PingOnly: Boolean;
begin
if lbServers.ItemIndex = -1 then Exit;
if GetForegroundWindow <> Handle then Exit;
Idx:= StrToInt(lbServers.Items.Strings[lbServers.ItemIndex]);
if Idx >= Length(Servers) then Exit;
if PingCounter = 5 then begin
PingCounter:= 0;
PingOnly:= false;
end else begin
Inc(PingCounter);
PingOnly:= true;
end;
if PingOnly then
QueryServerInfo(Servers[Idx].Address + ':' + IntToStr(Servers[Idx].Port) + '#' + IntToStr(Servers[Idx].Tag), true, false, false, false)
else
QueryServerInfo(Servers[Idx].Address + ':' + IntToStr(Servers[Idx].Port) + '#' + IntToStr(Servers[Idx].Tag), true, true, true, true);
end;
procedure TfmMain.lbServersClick(Sender: TObject);
var
Enabled: Boolean;
begin
if SelServer <> lbServers.ItemIndex then begin
SelServer:= lbServers.ItemIndex;
chSIPingChart.Series[0].Clear;
end;
lbPlayers.Clear;
lbRules.Clear;
Enabled:= lbServers.ItemIndex <> -1;
tbDeleteServer.Enabled:= MasterFile = 0;
miDeleteServer.Enabled:= tbDeleteServer.Enabled;
tbConnect.Enabled:= Enabled;
miConnect.Enabled:= Enabled;
tbRefreshServer.Enabled:= Enabled;
miRefreshServer.Enabled:= Enabled;
tbCopyServerInfo.Enabled:= Enabled;
miCopyServerInfo.Enabled:= Enabled;
tbServerProperties.Enabled:= Enabled;
miServerProperties.Enabled:= Enabled;
if lbServers.ItemIndex = -1 then begin
edSIAddress.Text:= '- - -';
lbSIPlayers.Caption:= '- - -';
lbSIPing.Caption:= '- - -';
lbSIMode.Caption:= '- - -';
lbSIMap.Caption:= '- - -';
gbInfo.Caption:= ' Server Info ';
Exit;
end;
RefreshServerClick(Self);
end;
procedure TfmMain.FilterChange(Sender: TObject);
begin
UpdateServers;
end;
procedure TfmMain.UpdateServers;
var
ActualIdx, Idx, i: Integer;
OldServ: String;
FilterList: TStringList;
ItemFiltered: Boolean;
Sorted: Boolean;
TrackingChanges: Boolean;
TotServers, TotSlots, TotPlayers: Integer;
NewServs: TStringList;
TopIndexes: Array[1..3] of Integer;
TopIndexSaved: Integer;
begin
if QueryQueue.Count > 0 then begin
lbServers.Items.BeginUpdate;
TrackingChanges:= true;
end;
TopIndexSaved:= lbServers.TopIndex;
NewServs:= TStringList.Create;
ServersTopIndex:= lbServers.TopIndex;
TopIndexes[1]:= lbServers.TopIndex;
TopIndexes[2]:= lbPlayers.TopIndex;
TopIndexes[3]:= lbRules.TopIndex;
Idx:= -1;
ActualIdx:= lbServers.ItemIndex;
if ActualIdx <> -1 then begin
Idx:= StrToInt(lbServers.Items.Strings[ActualIdx]);
if Idx < Length(Servers) then
OldServ:= Servers[Idx].Address + ':' + IntToStr(Servers[Idx].Port);
end;
Sorted:= false;
if (OldSortMode <> SortMode) or (OldSortDir <> SortDir) then begin
OldSortMode:= SortMode;
OldSortDir:= SortDir;
Sorted:= true;
case SortMode of
smHostName: SortArray(Servers[0], 0, SizeOf(TServerInfo), 0, Length(Servers)-1, CompareHostName);
smPlayers : SortArray(Servers[0], 0, SizeOf(TServerInfo), 0, Length(Servers)-1, ComparePlayers);
smPing : SortArray(Servers[0], 0, SizeOf(TServerInfo), 0, Length(Servers)-1, ComparePing);
smMode : SortArray(Servers[0], 0, SizeOf(TServerInfo), 0, Length(Servers)-1, CompareMode);
smMap : SortArray(Servers[0], 0, SizeOf(TServerInfo), 0, Length(Servers)-1, CompareMap);
end;
end;
if Filtered then begin
FilterList:= TStringList.Create;
for i:= 0 to Length(Servers) -1 do begin
ItemFiltered:= false;
// Check the mode filter...
if edFilterMode.Text <> '' then
if Pos(Lowercase(edFilterMode.Text), Lowercase(Servers[i].Mode)) = 0 then
ItemFiltered:= true;
// Check the mode filter...
if edFilterMap.Text <> '' then
if Pos(Lowercase(edFilterMap.Text), Lowercase(Servers[i].Map)) = 0 then
ItemFiltered:= true;
// Check the "Not Full" filter...
if cbFilterFull.Checked then
if Servers[i].Players = Servers[i].MaxPlayers then
ItemFiltered:= true;
// Check the "Not Empty" filter...
if cbFilterEmpty.Checked then
if Servers[i].Players = 0 then
ItemFiltered:= true;
// Check the "Not Passworded" filter...
if cbFilterPassworded.Checked then
if Servers[i].Passworded then
ItemFiltered:= true;
// Server hasn't responded yet.
if (Servers[i].MaxPlayers < 1) and (MasterFile <> 0) then
ItemFiltered:= true;
// If this server hasn't been filtered...
if not ItemFiltered then
FilterList.Add(IntToStr(i));
end;
if SortDir = sdDown then begin
for i:= FilterList.Count -1 downto 0 do
NewServs.Add(FilterList.Strings[i]);
end else
NewServs.Text:= FilterList.Text;
FilterList.Free;
end else begin
if SortDir = sdDown then begin
for i:= Length(Servers) -1 downto 0 do
if (Servers[i].MaxPlayers > 0) or (MasterFile = 0) then
NewServs.Add(IntToStr(i));
end else begin
for i:= 0 to Length(Servers) -1 do
if (Servers[i].MaxPlayers > 0) or (MasterFile = 0) then
NewServs.Add(IntToStr(i));
end;
end;
if lbServers.Items.Text <> NewServs.Text then begin
lbServers.Items.Text:= NewServs.Text;
lbServers.TopIndex:= TopIndexes[1];
end;
if (ActualIdx <> -1) and (Idx <> -1) and (Idx < Length(Servers)) then begin
NewServs.Clear;
for i:= 0 to Length(Servers[Idx].aPlayers)-1 do
NewServs.Add(IntToStr(i));
if lbPlayers.Items.Text <> NewServs.Text then begin
lbPlayers.Items.Text:= NewServs.Text;
lbPlayers.TopIndex:= TopIndexes[2];
end;
NewServs.Clear;
label_url.Caption:= '';
for i:= 0 to Length(Servers[Idx].aRules)-1 do begin
NewServs.Add(IntToStr(i));
if Servers[Idx].aRules[i].Rule = 'weburl' then
label_url.Caption:= Trim(Servers[Idx].aRules[i].Value);
end;
if lbRules.Items.Text <> NewServs.Text then begin
lbRules.Items.Text:= NewServs.Text;
lbRules.TopIndex:= TopIndexes[3];
end;
end;
NewServs.Free;
if Sorted then begin
for i:= 0 to lbServers.Count -1 do begin
Idx:= StrToInt(lbServers.Items.Strings[i]);
if Servers[Idx].Address + ':' + IntToStr(Servers[Idx].Port) = OldServ then begin
lbServers.ItemIndex:= i;
//lbServersClick(Self);
break;
end;
end;
end else
if ActualIdx <> -1 then
if ActualIdx < lbServers.Items.Count then
lbServers.ItemIndex:= ActualIdx;
if Filtered then begin
if lbServers.ItemIndex <> -1 then begin
Idx:= StrToInt(lbServers.Items.Strings[lbServers.ItemIndex]);
if Idx < Length(Servers) then begin
edSIAddress.Text:= Servers[Idx].Address + ':' + IntToStr(Servers[Idx].Port);
lbSIPlayers.Caption:= IntToStr(Servers[Idx].Players) + ' / ' + IntToStr(Servers[Idx].MaxPlayers);
lbSIPing.Caption:= IntToStr(Servers[Idx].Ping);
lbSIMode.Caption:= Servers[Idx].Mode;
lbSIMap.Caption:= Servers[Idx].Map;
gbInfo.Caption:= ' Server Info: ' + Servers[Idx].HostName + ' ';
end;
end;
end;
TotServers:= lbServers.Items.Count;
TotSlots:= 0;
TotPlayers:= 0;
for i:= 0 to Length(Servers) -1 do begin
Inc(TotSlots, Servers[i].MaxPlayers);
Inc(TotPlayers, Servers[i].Players);
end;
sbMain.SimpleText:= 'Servers: '+IntToStr(TotPlayers)+' players, playing on '+IntToStr(TotServers)+' servers. ('+IntToStr(TotSlots)+' player slots available)';
if lbServers.ItemIndex = -1 then
lbServers.ItemIndex:= 0;
if lbServers.Items.Count >= TopIndexSaved then
lbServers.TopIndex:= TopIndexSaved;
if TrackingChanges = true then
lbServers.Items.EndUpdate;
Application.ProcessMessages;
end;
procedure TfmMain.lbServersContextPopup(Sender: TObject; MousePos: TPoint;
var Handled: Boolean);
begin
Handled:= lbServers.ItemIndex = -1;
end;
procedure TfmMain.ImportFavoritesClick(Sender: TObject);
var
OD: TOpenDialog;
fmImportFavorites: TfmImportFavorites;
AddToFavs: Boolean;
begin
tsServerLists.TabIndex:= 0;
OD:= TOpenDialog.Create(Self);
OD.DefaultExt:= 'fav';
OD.Filter:= 'SA-MP Favorites List (*.fav)|*.fav';
OD.Options:= [ofEnableSizing,ofFileMustExist];
OD.Title:= 'Import Favorites';
if not OD.Execute then begin
OD.Free;
Exit;
end;
fmImportFavorites:= TfmImportFavorites.Create(Application);
fmImportFavorites.ShowModal;
AddToFavs:= fmImportFavorites.rbAddToCurrent.Checked;
fmImportFavorites.Free;
ImportFavorites(OD.FileName, AddToFavs);
OD.Free;
ExportFavorites(sub_4E1DA8 + 'USERDATA.DAT', true);
end;
procedure TfmMain.ImportFavorites(FileName: String; AddToFavs: Boolean);
var
ImportFile: File;
Temp, Temp2, i, j, x: Integer;
Dubble: Boolean;
ThisTag: Array[0..3] of Char;
begin
AssignFile(ImportFile, FileName);
FileMode:= 0;
Reset(ImportFile, 1);
BlockRead(ImportFile, ThisTag[0], 4);
if ThisTag <> FileTag then begin
MessageDlg('Invalid SA-MP file.', mtError, [mbOk], 0);
CloseFile(ImportFile);
Exit;
end;
BlockRead(ImportFile, Temp, 4);
if Temp <> FavoritesFileVersion then begin
MessageDlg('Bad SA-MP favorites file version.'#13#10#13#10'Your client may need updating.', mtError, [mbOk], 0);
CloseFile(ImportFile);
Exit;
end;
// Number of servers in file
BlockRead(ImportFile, Temp2, 4);
if not AddToFavs then
SetLength(Servers, 0);
for j:= 1 to Temp2 do begin
Dubble:= false;
i:= Length(Servers);
SetLength(Servers, i+1);
// Address
BlockRead(ImportFile, Temp, 4);
SetLength(Servers[i].Address, Temp);
if Temp <> 0 then
BlockRead(ImportFile, Servers[i].Address[1], Temp);
// Port
BlockRead(ImportFile, Servers[i].Port, 4);
for x:= 0 to Length(Servers)-2 do begin
if (Servers[x].Address = Servers[i].Address) and (Servers[x].Port = Servers[i].Port) then begin
Dubble:= true;
Break;
end;
end;
// Hostname
BlockRead(ImportFile, Temp, 4);
SetLength(Servers[i].HostName, Temp);
BlockRead(ImportFile, Servers[i].HostName[1], Temp);
// Server password
BlockRead(ImportFile, Temp, 4);
SetLength(Servers[i].ServerPassword, Temp);
if Temp <> 0 then
BlockRead(ImportFile, Servers[i].ServerPassword[1], Temp);
// Rcon password
BlockRead(ImportFile, Temp, 4);
SetLength(Servers[i].RconPassword, Temp);
if Temp <> 0 then
BlockRead(ImportFile, Servers[i].RconPassword[1], Temp);
Servers[i].Ping:= 9999;
Servers[i].Tag:= Random($FFFF);
if Dubble then
SetLength(Servers, i)
else
QueryQueue.Add(Servers[i].Address + ':' + IntToStr(Servers[i].Port) + '#' + IntToStr(Servers[i].Tag));
//QueryServerInfo(Servers[i].Address + ':' + IntToStr(Servers[i].Port), true, true, false, false);
end;
CloseFile(ImportFile);
UpdateServers;
end;
procedure TfmMain.ExportFavoritesClick(Sender: TObject);
var
SD: TSaveDialog;
fmExportFavorites: TfmExportFavorites;
ExportPasswords: Boolean;
begin
tsServerLists.TabIndex:= 0;
SD:= TSaveDialog.Create(Self);
SD.DefaultExt:= 'fav';
SD.Filter:= 'SA-MP Favorites List (*.fav)|*.fav';
SD.Options:= [ofHideReadOnly,ofEnableSizing];
SD.Title:= 'Export Favorites';
if not SD.Execute then begin
SD.Free;
Exit;
end else begin
if FileExists(SD.FileName) then begin
if MessageDlg('File '''+SD.FileName+''' already exists. Overwrite?', mtConfirmation, [mbYes, mbNo], 0) = mrNo then begin
SD.Free;
Exit;
end;
end;
end;
fmExportFavorites:= TfmExportFavorites.Create(Application);
fmExportFavorites.ShowModal;
ExportPasswords:= fmExportFavorites.cbIncludeSavedPasswords.Checked;
fmExportFavorites.Free;
ExportFavorites(SD.FileName, ExportPasswords);
SD.Free;
end;
procedure TfmMain.ExportFavorites(FileName: String; ExportPasswords: Boolean);
var
ExportFile: File;
Temp, i: Integer;
begin
AssignFile(ExportFile, FileName);
FileMode:= 1;
Rewrite(ExportFile, 1);
BlockWrite(ExportFile, FileTag[0], 4);
Temp:= FavoritesFileVersion;
BlockWrite(ExportFile, Temp, 4);
Temp:= Length(Servers);
BlockWrite(ExportFile, Temp, 4);
for i:= 0 to Length(Servers)-1 do begin
Temp:= Length(Servers[i].Address);
BlockWrite(ExportFile, Temp, 4);
if Temp <> 0 then
BlockWrite(ExportFile, Servers[i].Address[1], Temp);
BlockWrite(ExportFile, Servers[i].Port, 4);
Temp:= Length(Servers[i].HostName);
BlockWrite(ExportFile, Temp, 4);
BlockWrite(ExportFile, Servers[i].HostName[1], Temp);
if ExportPasswords then begin
Temp:= Length(Servers[i].ServerPassword);
BlockWrite(ExportFile, Temp, 4);
if Temp <> 0 then
BlockWrite(ExportFile, Servers[i].ServerPassword[1], Temp);
Temp:= Length(Servers[i].RconPassword);
BlockWrite(ExportFile, Temp, 4);
if Temp <> 0 then
BlockWrite(ExportFile, Servers[i].RconPassword[1], Temp);
end else begin
Temp:= 0;
BlockWrite(ExportFile, Temp, 4);
BlockWrite(ExportFile, Temp, 4);
end;
end;
CloseFile(ExportFile);
end;
procedure TfmMain.ExitClick(Sender: TObject);
begin
Close;
end;
procedure TfmMain.miViewClick(Sender: TObject);
begin
miFilterServerInfo.Checked:= Filtered;
miStatusBar.Checked:= sbMain.Visible;
end;
procedure TfmMain.ToggleFilterServerInfo(Sender: TObject);
begin
if Filtered then begin
Filtered:= false;
pnBreakable.Height:= 16;
gbInfo.Caption:= ' Server Info ';
end else begin
Filtered:= true;
pnBreakable.Height:= 100;
pnBreakable.Top:= 0;
if lbServers.ItemIndex <> -1 then
gbInfo.Caption:= ' Server Info: ' + Servers[StrToInt(lbServers.Items.Strings[lbServers.ItemIndex])].HostName + ' ';
end;
UpdateServers;
end;
procedure TfmMain.ToggleStatusBar(Sender: TObject);
begin
sbMain.Visible:= not sbMain.Visible;
sbMain.Top:= 10000;
end;
procedure TfmMain.ConnectClick(Sender: TObject);
var
Idx: Integer;
SrvPwd: String;
NickName: String;
begin
if lbServers.ItemIndex = -1 then Exit;
Idx:= StrToInt(lbServers.Items.Strings[lbServers.ItemIndex]);
if Idx >= Length(Servers) then Exit;
SrvPwd:= Servers[Idx].ServerPassword;
if Servers[Idx].Passworded then
if not InputQuery('Server Password', 'This server requires a password...', SrvPwd) then
Exit;
if edName.Text = '' then begin
if not InputQuery('Who are you?', 'Enter your nickname/handle...', NickName) then
Exit;
if NickName = '' then
Exit;
edName.Text:= NickName;
end;
ServerConnect(Servers[Idx].Address, IntToStr(Servers[Idx].Port), SrvPwd);
end;
procedure TfmMain.AddServerClick(Sender: TObject);
var
Server: String;
Dummy: Boolean;
begin
Server:= GetClipBoardStr;
if (MasterFile <> 0) and (lbServers.ItemIndex <> -1) then begin
Server:= Servers[StrToIntDef(lbServers.Items.Strings[lbServers.ItemIndex], 0)].Address + ':' +
IntToStr(Servers[StrToIntDef(lbServers.Items.Strings[lbServers.ItemIndex], 0)].Port);
tsServerLists.TabIndex:= 0;
tsServerListsChange(tsServerLists, 0, Dummy);
end;
if InputQuery('Add Server', 'Enter new server HOST:PORT...', Server) then
if Server <> '' then begin
AddServer(Server);
end;
end;
procedure TfmMain.AddServer(Server: String);
var
i, j: Integer;
Dupe: Boolean;
begin
Server:= Trim(Server);
i:= Length(Servers);
SetLength(Servers, i + 1);
if Pos(':', Server) <> 0 then begin
Servers[i].Address:= Copy(Server, 1, Pos(':', Server)-1);
Servers[i].Port:= StrToIntDef(Copy(Server, Pos(':', Server)+1, 5), 7777);
end else begin
Servers[i].Address:= Server;
Servers[i].Port:= 7777;
end;
Servers[i].HostName:= '(Retrieving info...) ' + Servers[i].Address + ':' + IntToStr(Servers[i].Port);
Dupe:= False;
for j:= 0 to i-1 do
if (Servers[j].Address = Servers[i].Address) and (Servers[j].Port = Servers[i].Port) then begin
SetLength(Servers, i);
MessageDlg('This server is already on your list.', mtError, [mbOk], 0);
Dupe:= True;
end;
if not Dupe then begin
//QueryServerInfo(Server, true, true, false, false);
QueryQueue.Add(Server);
ExportFavorites(sub_4E1DA8 + 'USERDATA.DAT', true);
FavoritesChanged:= true;
end;
UpdateServers;
end;
procedure TfmMain.DeleteServerClick(Sender: TObject);
var
Idx, i: Integer;
begin
if lbServers.ItemIndex = -1 then Exit;
if tsServerLists.TabIndex <> 0 then Exit;
Idx:= StrToInt(lbServers.Items.Strings[lbServers.ItemIndex]);
lbServers.Items.Delete(lbServers.ItemIndex);
for i:= Idx to Length(Servers)-2 do
Servers[i]:= Servers[i+1];
SetLength(Servers, Length(Servers)-1);
UpdateServers;
ExportFavorites(sub_4E1DA8 + 'USERDATA.DAT', true);
FavoritesChanged:= true;
end;
procedure TfmMain.RefreshServerClick(Sender: TObject);
var
Idx: Integer;
begin
if lbServers.ItemIndex = -1 then Exit;
Idx:= StrToInt(lbServers.Items.Strings[lbServers.ItemIndex]);
if Idx >= Length(Servers) then Exit;
QueryServerInfo(Servers[Idx].Address + ':' + IntToStr(Servers[Idx].Port) + '#' + IntToStr(Servers[Idx].Tag), true, true, true, true);
end;
procedure TfmMain.MasterServerUpdateClick(Sender: TObject);
var
SL: TStringList;
i: Integer;
IdHTTP: TIdHTTP;
fmMasterUpdate: TfmMasterUpdate;
begin
fmMasterUpdate:= TfmMasterUpdate.Create(Application);
fmMasterUpdate.Show;
Enabled:= false;
Application.ProcessMessages;
IdHTTP:= TIdHTTP.Create(Application);
with IdHTTP do begin
ReadTimeout:= 20000; // 20secs
AllowCookies:= true;
ProxyParams.BasicAuthentication:= False;
ProxyParams.ProxyPort:= 0;
Port:= 80;
Host:= 'lists.sa-mp.com';
Request.Host:= IdHTTP.Host;
Request.ContentLength:= -1;
Request.ContentRangeEnd:= 0;
Request.ContentRangeStart:= 0;
Request.ContentType:= 'text/html';
Request.Accept:= 'text/html, */*';
Request.BasicAuthentication:= False;
Request.UserAgent:= 'Mozilla/3.0 (compatible; SA:MP v0.3.7)';
HTTPOptions:= [hoForceEncodeParams];
end;
SL:= TStringList.Create;
try
if MasterFile = 1 then
SL.Text:= IdHTTP.Get('/0.3.7/internet')
else if MasterFile = 2 then
SL.Text:= IdHTTP.Get('/0.3.7/hosted');
except
// STATUS: BAD RESPONCE FROM MASTER SERVER
end;
IdHTTP.Free;
lbServers.Clear;
lbPlayers.Clear;
lbRules.Clear;
SetLength(Servers, 0);
tmrQueryQueueProcess.Enabled := false;
tmrServerListUpdate.Enabled := false;
SetLength(Servers, SL.Count);
Enabled:= true;
fmMasterUpdate.Close;
fmMasterUpdate.Free;
for i:= 0 to SL.Count -1 do begin
//Application.ProcessMessages;
Servers[i].HostName:= '(Retrieving info...) ' + SL.Strings[i];
Servers[i].Address:= Copy(SL.Strings[i], 1, Pos(':', SL.Strings[i])-1);
Servers[i].Port:= StrToIntDef(Copy(SL.Strings[i], Pos(':', SL.Strings[i])+1, 5), 7777);
Servers[i].Ping:= 9999;
Servers[i].Tag:= Random($FFFF);
//QueryServerInfo(SL.Strings[i], true, true, false, false);
//Sleep(10);
QueryQueue.Add(SL.Strings[i] + '#' + IntToStr(Servers[i].Tag));
end;
tmrQueryQueueProcess.Enabled := true;
tmrServerListUpdate.Enabled := true;
SL.Free;
dword_4EF08C.Clear;
//UpdateServers;
end;
procedure TfmMain.CopyServerInfoClick(Sender: TObject);
var
Idx: Integer;
Str: String;
begin
if lbServers.ItemIndex = -1 then Exit;
Idx:= StrToInt(lbServers.Items.Strings[lbServers.ItemIndex]);
if Idx >= Length(Servers) then Exit;
Str:= 'HostName: ' + Servers[Idx].HostName + #13#10 +
'Address: ' + Servers[Idx].Address + ':' + IntToStr(Servers[Idx].Port) + #13#10 +
'Players: ' + IntToStr(Servers[Idx].Players) + ' / ' + IntToStr(Servers[Idx].MaxPlayers) + #13#10 +
'Ping: ' + IntToStr(Servers[Idx].Ping) + #13#10 +
'Mode: ' + Servers[Idx].Mode + #13#10 +
'Language: ' + Servers[Idx].Map;
SetClipBoardStr(Str);
end;
procedure TfmMain.ServerPropertiesClick(Sender: TObject);
var
fmServerProperties: TfmServerProperties;
Idx: Integer;
begin
if lbServers.ItemIndex = -1 then Exit;
Idx:= StrToInt(lbServers.Items.Strings[lbServers.ItemIndex]);
if Idx >= Length(Servers) then Exit;
fmServerProperties:= TfmServerProperties.Create(Application);
with fmServerProperties do begin
lbHostName.Caption:= Servers[Idx].HostName;
edAddress.Text:= Servers[Idx].Address + ':' + IntToStr(Servers[Idx].Port);
lbPlayers.Caption:= IntToStr(Servers[Idx].Players) + ' / ' + IntToStr(Servers[Idx].MaxPlayers);
lbPing.Caption:= IntToStr(Servers[Idx].Ping);
lbMode.Caption:= Servers[Idx].Mode;
lbMap.Caption:= Servers[Idx].Map;
edServerPassword.Text:= Servers[Idx].ServerPassword;
edRconPassword.Text:= Servers[Idx].RconPassword;
edServerPassword.Enabled:= Servers[Idx].Passworded;
if not Servers[Idx].Passworded then
edServerPassword.Color:= clBtnFace;
ShowModal;
Free;
end;
end;
procedure TfmMain.RemoteConsoleClick(Sender: TObject);
var
fmRconConfig: TfmRconConfig;
Idx: Integer;
begin
fmRconConfig:= TfmRconConfig.Create(Application);
if lbServers.ItemIndex <> -1 then begin
Idx:= StrToInt(lbServers.Items.Strings[lbServers.ItemIndex]);
fmRconConfig.edHost.Text:= Servers[Idx].Address + ':' + IntToStr(Servers[Idx].Port);
fmRconConfig.edPassword.Text:= Servers[Idx].RconPassword;
end;
fmRconConfig.ShowModal;
fmRconConfig.Free;
end;
procedure TfmMain.SettingsClick(Sender: TObject);
var
fmSettings: TfmSettings;
begin
fmSettings:= TfmSettings.Create(Application);
fmSettings.ShowModal;
fmSettings.Free;
end;
procedure TfmMain.HelpTopicsClick(Sender: TObject);
begin
ShellExecute(Handle, 'open', 'http://wiki.sa-mp.com/', nil, nil, SW_SHOWNORMAL);
end;
procedure TfmMain.AboutClick(Sender: TObject);
begin
fmAbout.ShowModal;
end;
procedure TfmMain.tsServerListsChange(Sender: TObject; NewTab: Integer;
var AllowChange: Boolean);
begin
if (tsServerLists.TabIndex = 0) and (FavoritesChanged = True) then begin
ExportFavorites(sub_4E1DA8 + 'USERDATA.DAT', true);
FavoritesChanged:= False;
end;
QueryQueue.Clear;
lbServers.Clear;
lbPlayers.Clear;
lbRules.Clear;
SetLength(Servers, 0);
if NewTab = 0 then begin
if FileExists(sub_4E1DA8 + 'USERDATA.DAT') then
ImportFavorites(sub_4E1DA8 + 'USERDATA.DAT', false);
end;
{
if NewTab <> 0 then begin
lbServers.Clear;
SetLength(Servers, 0);
end;
}
UpdateServers;
tbMasterServerUpdate.Enabled:= NewTab <> 0;
miMasterServerUpdate.Enabled:= NewTab <> 0;
//tbAddServer.Enabled:= NewTab = 0;
miAddServer.Enabled:= NewTab = 0;
tbDeleteServer.Enabled:= NewTab = 0;
miDeleteServer.Enabled:= NewTab = 0;
piDeleteServer.Visible:= NewTab = 0;
if lbServers.Count > 0 then
lbServers.ItemIndex:= 0;
MasterFile:= NewTab;
lbServersClick(Self);
if NewTab <> 0 then
MasterServerUpdateClick(Self);
dword_4EF08C.Clear;
end;
procedure TfmMain.QueryServerInfoParse(SrcIP: String; SrcPort: Word; Buf: PAnsiChar; DataLen: Integer);
var
StrIP: String;
Tag: Word;
i, j, Idx: Integer;
Magic: array[0..3] of char;
ping: Cardinal;
TempWord: Word;
TempCard: Cardinal;
TempByte: Byte;
BufPos: Integer;
Value: Double;
RepaintServerList,
RepaintPlayerList,
RepaintRulesList: Boolean;
TempInt: Integer;
Port: Word;
begin
if DataLen < 11 then Exit; // 10b is min size: 4b magic, 4b ip, 2b port, 1b id
Move(Buf[0], Magic[0], 4);
if Magic <> 'SAMP' then Exit;
StrIP:= IntToStr(Byte(Buf[4]))+'.'+IntToStr(Byte(Buf[5]))+'.'+
IntToStr(Byte(Buf[6]))+'.'+IntToStr(Byte(Buf[7]));
Move(Buf[8], Port, 2);
Tag:= SrcPort;
if SrcIP <> StrIP then Exit;
Idx:= -1;
for i:= 0 to Length(Servers)-1 do begin
if Servers[i].DottedAddress = '' then begin
if not Servers[i].HasAddress then begin
Servers[i].DottedAddress:= GetIPFromHost(Servers[i].Address);
Servers[i].HasAddress:= true;
end;
end;
if (Servers[i].Address = SrcIP) or (Servers[i].DottedAddress = SrcIP) then begin
if Servers[i].Port = SrcPort then begin
Idx:= i;
break;
end;
end;
if (Servers[i].Address = SrcIP) and (Servers[i].Port = SrcPort) then begin
Idx:= i;
break;
end;
end;
if Idx = -1 then begin
//fmMain.Caption:= 'Server not found ' + StrIP;
Exit;
end;
if (Servers[i].Tag <> 0) and (Servers[i].Tag <> Port) then begin
//fmMain.Caption:= 'Invalid tag for ' + StrIP;
Exit;
end;
RepaintServerList:= false;
RepaintPlayerList:= false;
RepaintRulesList:= false;
case Buf[10] of // PacketID
'p': // Ping
begin
//OutputDebugString(PChar('[P] Packet from ' + Servers[Idx].Address + ':' + IntToStr(Servers[Idx].Port)));
if DataLen = 15 then begin
Move(Buf[11], ping, 4);
timeBeginPeriod(5);
Servers[Idx].Ping:= timeGetTime - ping;
Value:= Servers[Idx].Ping;
if Value < 1 then Value:= 1;
i:= chSIPingChart.Series[0].AddY(Value, '', clBlue);
if i > 60 then begin
for j:= 1 to 61 do begin
chSIPingChart.Series[0].YValue[j-1]:= chSIPingChart.Series[0].YValue[j];
end;
chSIPingChart.Series[0].Delete(61);
end;
chSIPingChart.LeftAxis.Maximum:= chSIPingChart.Series[0].MaxYValue / 2 * 3;
timeEndPeriod(5);
RepaintServerList:= true;
end;
end;
'i': // Info
begin
BufPos:= 11;
//OutputDebugString(PChar('[I] Packet from ' + Servers[Idx].Address + ':' + IntToStr(Servers[Idx].Port)));
Move(Buf[BufPos], TempByte, 1);
Inc(BufPos, 1);
Servers[Idx].Passworded:= TempByte <> 0;
Move(Buf[BufPos], TempWord, 2);
if TempWord > 1000 then TempWord:= 1000;
Inc(BufPos, 2);
Servers[Idx].Players:= TempWord;
Move(Buf[BufPos], TempWord, 2);
if TempWord > 1000 then TempWord:= 1000;
Inc(BufPos, 2);
Servers[Idx].MaxPlayers:= TempWord;
if Servers[Idx].Players > Servers[Idx].MaxPlayers then
Servers[Idx].Players:= Servers[Idx].MaxPlayers;
Servers[Idx].HostName:= '-';
Servers[Idx].Mode:= '-';
Servers[Idx].Map:= '-';
Move(Buf[BufPos], TempCard, 4);
if (TempCard > 0) and (TempCard < 64) then begin
Inc(BufPos, 4);
SetLength(Servers[Idx].HostName, TempCard);
Move(Buf[BufPos], Servers[Idx].HostName[1], TempCard);
Inc(BufPos, TempCard);
Move(Buf[BufPos], TempCard, 4);
if (TempCard > 0) and (TempCard < 40) then begin
Inc(BufPos, 4);
SetLength(Servers[Idx].Mode, TempCard);
Move(Buf[BufPos], Servers[Idx].Mode[1], TempCard);
Inc(BufPos, TempCard);
Move(Buf[BufPos], TempCard, 4);
if (TempCard > 0) and (TempCard < 40) then begin
Inc(BufPos, 4);
SetLength(Servers[Idx].Map, TempCard);
Move(Buf[BufPos], Servers[Idx].Map[1], TempCard);
//Inc(BufPos, TempCard);
end;
end;
end;
RepaintServerList:= true;
QueryServerInfo(Servers[Idx].Address+':'+IntToStr(Servers[Idx].Port)+'#'+IntToStr(Servers[Idx].Tag), true, false, false, false);
end;
'c': // Players
begin
BufPos:= 11;
//OutputDebugString(PChar('[C] Packet from ' + Servers[Idx].Address + ':' + IntToStr(Servers[Idx].Port)));
Move(Buf[BufPos], TempWord, 2);
if TempWord > 100 then TempWord:= 100;
Inc(BufPos, 2);
Servers[Idx].Players:= TempWord;
SetLength(Servers[Idx].aPlayers, TempWord);
for i:= 0 to TempWord -1 do begin
Move(Buf[BufPos], TempByte, 1);
Inc(BufPos, 1);
if BufPos > DataLen then break;
SetLength(Servers[Idx].aPlayers[i].Name, TempByte);
Move(Buf[BufPos], Servers[Idx].aPlayers[i].Name[1], TempByte);
Inc(BufPos, TempByte);
if BufPos > DataLen then break;
Move(Buf[BufPos], TempInt, 4);
if TempInt > 1000000 then TempInt:= 1000000;
if TempInt < 0 then TempInt:= 0;
Servers[Idx].aPlayers[i].Score:= TempInt;
Inc(BufPos, 4);
if BufPos > DataLen then break;
end;
RepaintPlayerList:= true;
end;
'r': // Rules
begin
BufPos:= 11;
//OutputDebugString(PChar('[R] Packet from ' + Servers[Idx].Address + ':' + IntToStr(Servers[Idx].Port)));
Move(Buf[BufPos], TempWord, 2);
if TempWord > 30 then TempWord:= 30;
Inc(BufPos, 2);
SetLength(Servers[Idx].aRules, TempWord);
for i:= 0 to TempWord -1 do begin
if BufPos > DataLen then break;
Move(Buf[BufPos], TempByte, 1);
Inc(BufPos, 1);
if BufPos > DataLen then break;
SetLength(Servers[Idx].aRules[i].Rule, TempByte);
Move(Buf[BufPos], Servers[Idx].aRules[i].Rule[1], TempByte);
Inc(BufPos, TempByte);
if BufPos > DataLen then break;
Move(Buf[BufPos], TempByte, 1);
Inc(BufPos, 1);
if BufPos > DataLen then break;
SetLength(Servers[Idx].aRules[i].Value, TempByte);
Move(Buf[BufPos], Servers[Idx].aRules[i].Value[1], TempByte);
Inc(BufPos, TempByte);
end;
RepaintRulesList:= true;
end;
end;
if QueryQueue.Count <= 0 then
UpdateServers;
if RepaintServerList then
lbServers.Invalidate;
if RepaintPlayerList then
lbPlayers.Invalidate;
if RepaintRulesList then
lbRules.Invalidate;
end;
procedure TfmMain.QueryServerInfoError(SocketError: Integer);
var
err: array[0..512] of Char;
begin
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil, SocketError, 0, @err, 512, nil);
MessageDlg(err, mtError, [mbOk], 0);
end;
procedure TfmMain.QueryServerInfo(Server: String; bPing: Boolean; bInfo: Boolean; bPlayers: Boolean; bRules: Boolean);
var
Buf: PByteArray;
Ticks: Cardinal;
ToAddr: TSockAddr;
ToLen: Integer;
Host: String;
Port: Word;
Tag: Word;
ColPos, TagPos: Integer;
begin
Tag:= 0;
if Pos(':', Server) <> 0 then begin
if Pos('#', Server) <> 0 then begin
ColPos:= Pos(':', Server);
TagPos:= Pos('#', Server);
Host:= Copy(Server, 1, ColPos-1);
Port:= StrToIntDef(Copy(Server, ColPos+1, TagPos-(ColPos+1)), 7777);
Tag:= StrToIntDef(Copy(Server, TagPos+1, Length(Server)-TagPos), 0);
end else begin
ColPos:= Pos(':', Server);
Host:= Copy(Server, 1, ColPos-1);
Port:= StrToIntDef(Copy(Server, ColPos+1, Length(Server)-ColPos+1), 7777);
end;
end else begin
Host:= Server;
Port:= 7777;
end;
if Tag = 0 then
Tag:= Port;
Host:= GetIPFromHost(Host);
if (Length(Host) < 7) or (Length(Host) > 15) then
Exit;
GetMem(Buf, 15);
Buf[0]:= Byte('S'); // Magic
Buf[1]:= Byte('A');
Buf[2]:= Byte('M');
Buf[3]:= Byte('P');
Buf[4]:= StrToIntDef(GetToken(Host, 1, '.'), 0); // IP
Buf[5]:= StrToIntDef(GetToken(Host, 2, '.'), 0);
Buf[6]:= StrToIntDef(GetToken(Host, 3, '.'), 0);
Buf[7]:= StrToIntDef(GetToken(Host, 4, '.'), 0);
//Move(Port, Buf[8], 2); // Port
ZeroMemory(@ToAddr, SizeOf(ToAddr));
ToAddr.sin_family:= AF_INET;
ToAddr.sin_port:= htons(Port);
ToAddr.sin_addr.S_addr:= inet_addr(PChar(Host));
ToLen:= SizeOf(ToAddr);
Move(Tag, Buf[8], 2); // Tag
if bInfo = true then begin
Buf[10]:= Byte('i'); // Info Packet Id
sendto(QuerySocket, Buf[0], 11, 0, ToAddr, ToLen);
Sleep(1);
end;
if bPing = true then begin
Buf[10]:= Byte('p'); // Ping Packet Id
timeBeginPeriod(1);
Ticks:= timeGetTime;
timeEndPeriod(1);
Move(Ticks, Buf[11], 4);
sendto(QuerySocket, Buf[0], 15, 0, ToAddr, ToLen);
Sleep(1);
end;
if bPlayers = true then begin
Buf[10]:= Byte('c'); // Players Packet Id
sendto(QuerySocket, Buf[0], 11, 0, ToAddr, ToLen);
Sleep(1);
end;
if bRules = true then begin
Buf[10]:= Byte('r'); // Rules Packet Id
sendto(QuerySocket, Buf[0], 11, 0, ToAddr, ToLen);
Sleep(1);
end;
FreeMem(Buf, 15);
end;
procedure TfmMain.ServerConnect(Server: String; Port: String; Password: String);
procedure GetDebugPrivs;
var
hToken: THandle;
xTokenPriv: TTokenPrivileges;
iRetLen: DWord;
begin
If OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) Then Begin
LookupPrivilegeValue(nil, 'SeDebugPrivilege', xTokenPriv.Privileges[0].Luid);
xTokenPriv.PrivilegeCount:= 1;
xTokenPriv.Privileges[0].Attributes:= SE_PRIVILEGE_ENABLED;
AdjustTokenPrivileges(hToken, False, xTokenPriv, 0, nil, iRetLen);
End;
end;
const
ACL_REVISION = 2;
var
StartInfo: TStartupInfo;
ProcInfo: TProcessInformation;
Created: Boolean;
hThread: THandle;
pLibRemote: Pointer;
NumBytes, ThreadID: Cardinal;
CmdLine, SAMP_DLL: String;
begin
if not FileExists(gta_sa_exe) then begin
MessageDlg('GTA: San Andreas executable not found.'#13#10'('+gta_sa_exe+')'#13#10#13#10'Please locate it now.', mtError, [mbOk], 0);
GetGTAExe(Handle);
end;
if not FileExists(gta_sa_exe) then begin
MessageDlg('GTA: San Andreas executable STILL not found.'#13#10'('+gta_sa_exe+')'#13#10#13#10'Aborting launch.', mtError, [mbOk], 0);
Exit;
end;
FillChar(StartInfo, SizeOf(TStartupInfo), 0);
FillChar(ProcInfo, SizeOf(TProcessInformation), 0);
StartInfo.cb:= SizeOf(TStartupInfo);
CmdLine:= ' -c -n ' + edName.Text + ' -h ' + GetIPFromHost(Server) + ' -p ' + Port;
if Password <> '' then
CmdLine:= CmdLine + ' -z ' + Password;
Created:= CreateProcess(nil, PChar('"' + gta_sa_exe + '"' + CmdLine), {@SA}nil, nil, false,
CREATE_NEW_PROCESS_GROUP+NORMAL_PRIORITY_CLASS+CREATE_SUSPENDED,
nil, PChar(ExtractFilePath(gta_sa_exe)), StartInfo, ProcInfo);
if not Created then begin
MessageDlg('Unable to execute.', mtError, [mbOk], 0);
Exit;
end;
if RT_GetVersion(nil) shr 31 = 0 then
GetDebugPrivs;
SAMP_DLL:= ExtractFilePath(gta_sa_exe) + 'samp.dll';
SetLength(SAMP_DLL, Length(SAMP_DLL)+1);
SAMP_DLL[Length(SAMP_DLL)]:= #0;
pLibRemote:= xVirtualAllocEx(ProcInfo.hProcess, nil, MAX_PATH, MEM_COMMIT, PAGE_READWRITE);
WriteProcessMemory(ProcInfo.hProcess, pLibRemote, PChar(SAMP_DLL), Length(SAMP_DLL), NumBytes);
hThread:= xCreateRemoteThread(ProcInfo.hProcess, nil, 0, GetProcAddress(GetModuleHandle('kernel32'), 'LoadLibraryA'), pLibRemote, 0, ThreadID);
WaitForSingleObject(hThread, 2000);
CloseHandle(hThread);
VirtualFreeEx(ProcInfo.hProcess, pLibRemote, MAX_PATH, MEM_RELEASE);
ResumeThread(ProcInfo.hThread);
//CloseHandle(ProcInfo.hProcess);
end;
procedure TfmMain.piCopyClick(Sender: TObject);
begin
SetClipBoardStr(edSIAddress.Text);
end;
procedure TfmMain.pmCopyPopup(Sender: TObject);
begin
piCopy.Enabled:= edSIAddress.Text <> '- - -';
end;
procedure TfmMain.lbPlayersDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
Idx: Integer;
TempRect: TRect;
begin
if lbServers.ItemIndex = -1 then Exit;
with (Control as TListBox) do begin
Idx:= StrToIntDef(lbServers.Items.Strings[lbServers.ItemIndex], 0);
if Idx >= Length(Servers) then Exit;
if Index >= Length(Servers[Idx].aPlayers) then
Exit;
Canvas.Pen.Color:= clBtnHighlight;
Canvas.Pen.Style:= psClear;
if odSelected in State then begin
Canvas.Font.Color:= clHighlightText;
Canvas.Brush.Color:= clHighlight;
end else begin
Canvas.Font.Color:= clWindowText;
if (Index mod 2) = 1 then
Canvas.Brush.Color:= clWindow
else
Canvas.Brush.Color:= sub_4E2628(clWindow);
end;
Inc(Rect.Right);
Canvas.Rectangle(Rect);
Dec(Rect.Right);
Canvas.Pen.Style:= psSolid;
Canvas.PenPos:= Point(Rect.Right, Rect.Bottom-1);
Canvas.LineTo(Rect.Left, Rect.Bottom-1);
Canvas.PenPos:= Point(hcPlayers.Sections.Items[0].Right-2, Rect.Top);
Canvas.LineTo(hcPlayers.Sections.Items[0].Right-2, Rect.Bottom);
Canvas.PenPos:= Point(hcPlayers.Sections.Items[1].Right-2, Rect.Top);
Canvas.LineTo(hcPlayers.Sections.Items[1].Right-2, Rect.Bottom);
TempRect:= Classes.Rect(hcPlayers.Sections.Items[0].Left + 2, Rect.Top + 2, hcPlayers.Sections.Items[0].Right - 2, Rect.Bottom - 2);
DrawText(Canvas.Handle, PChar(Servers[Idx].aPlayers[Index].Name), -1, TempRect, DT_LEFT);
TempRect:= Classes.Rect(hcPlayers.Sections.Items[1].Left + 2, Rect.Top + 2, hcPlayers.Sections.Items[1].Right - 2, Rect.Bottom - 2);
DrawText(Canvas.Handle, PChar(IntToStr(Servers[Idx].aPlayers[Index].Score)), -1, TempRect, DT_LEFT);
end;
end;
procedure TfmMain.hcPlayersSectionResize(HeaderControl: THeaderControl;
Section: THeaderSection);
begin
lbPlayers.Repaint;
end;
procedure TfmMain.lbRulesDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
Idx: Integer;
TempRect: TRect;
begin
if lbServers.ItemIndex = -1 then Exit;
with (Control as TListBox) do begin
Idx:= StrToIntDef(lbServers.Items.Strings[lbServers.ItemIndex], 0);
if Idx >= Length(Servers) then Exit;
if Index >= Length(Servers[Idx].aRules) then
Exit;
Canvas.Pen.Color:= clBtnHighlight;
Canvas.Pen.Style:= psClear;
if odSelected in State then begin
Canvas.Font.Color:= clHighlightText;
Canvas.Brush.Color:= clHighlight;
end else begin
Canvas.Font.Color:= clWindowText;
if (Index mod 2) = 1 then
Canvas.Brush.Color:= clWindow
else
Canvas.Brush.Color:= sub_4E2628(clWindow);
end;
Inc(Rect.Right);
Canvas.Rectangle(Rect);
Dec(Rect.Right);
Canvas.Pen.Style:= psSolid;
Canvas.PenPos:= Point(Rect.Right, Rect.Bottom-1);
Canvas.LineTo(Rect.Left, Rect.Bottom-1);
Canvas.PenPos:= Point(hcRules.Sections.Items[0].Right-2, Rect.Top);
Canvas.LineTo(hcRules.Sections.Items[0].Right-2, Rect.Bottom);
Canvas.PenPos:= Point(hcRules.Sections.Items[1].Right-2, Rect.Top);
Canvas.LineTo(hcRules.Sections.Items[1].Right-2, Rect.Bottom);
TempRect:= Classes.Rect(hcRules.Sections.Items[0].Left + 2, Rect.Top + 2, hcRules.Sections.Items[0].Right - 2, Rect.Bottom - 2);
DrawText(Canvas.Handle, PChar(Servers[Idx].aRules[Index].Rule), -1, TempRect, DT_LEFT);
TempRect:= Classes.Rect(hcRules.Sections.Items[1].Left + 2, Rect.Top + 2, hcRules.Sections.Items[1].Right - 2, Rect.Bottom - 2);
DrawText(Canvas.Handle, PChar(Servers[Idx].aRules[Index].Value), -1, TempRect, DT_LEFT);
end;
end;
procedure TfmMain.hcRulesSectionResize(HeaderControl: THeaderControl;
Section: THeaderSection);
begin
lbRules.Repaint;
end;
procedure TfmMain.sbMainDrawPanel(StatusBar: TStatusBar;
Panel: TStatusPanel; const Rect: TRect);
var
Pcnt: Integer;
begin
StatusBar.Canvas.Brush.Color:= clBtnFace;
StatusBar.Canvas.Rectangle(Rect);
StatusBar.Canvas.Brush.Color:= $00804000;
Pcnt:= Round(((Rect.Right-Rect.Left) / 100.0) * 75.0);
StatusBar.Canvas.Rectangle(Rect.Left, Rect.Top, Rect.Left+Pcnt, Rect.Bottom);
end;
procedure TfmMain.lbPlayersExit(Sender: TObject);
begin
lbPlayers.ItemIndex:= -1;
end;
procedure TfmMain.lbRulesExit(Sender: TObject);
begin
lbRules.ItemIndex:= -1;
end;
procedure TfmMain.WMRecv(var Message: TMessage);
var
lpBuffer: Array[0..2048] of Char;
BufLen: Integer;
FromAddr: TSockAddr;
FromLen: Integer;
SrcAddr: String;
SrcPort: Word;
begin
ZeroMemory(@lpBuffer, sizeof(lpBuffer));
ZeroMemory(@FromAddr, sizeof(FromAddr));
FromAddr.sin_family:= AF_INET;
FromLen:= SizeOf(FromAddr);
BufLen:= recvfrom(QuerySocket, lpBuffer, 2048, 0, FromAddr, FromLen);
SrcAddr:= inet_ntoa(FromAddr.sin_addr);
SrcPort:= htons(FromAddr.sin_port);
while (BufLen > 0) do begin
//OutputDebugString( PChar('[*] of size ' + IntToStr(BufLen)) );
QueryServerInfoParse(SrcAddr,SrcPort,lpBuffer,BufLen);
ZeroMemory(@lpBuffer, sizeof(lpBuffer));
BufLen:= recvfrom(QuerySocket, lpBuffer, 2048, 0, FromAddr, FromLen);
SrcAddr:= inet_ntoa(FromAddr.sin_addr);
SrcPort:= htons(FromAddr.sin_port);
end;
end;
procedure TfmMain.FormDestroy(Sender: TObject);
var
Reg: TRegistry;
begin
Reg:= TRegistry.Create;
Reg.RootKey:= HKEY_CURRENT_USER;
Reg.OpenKey('SOFTWARE\SAMP', true);
Reg.WriteString('PlayerName', edName.Text);
Reg.CloseKey;
Reg.Free;
CloseSocket(QuerySocket);
ShutDown(QuerySocket, 0);
WSACleanup;
QueryQueue.Free;
if (tsServerLists.TabIndex = 0) and (FavoritesChanged = True) then begin
ExportFavorites(sub_4E1DA8 + 'USERDATA.DAT', True);
FavoritesChanged:= False;
end;
Sleep(0);
end;
procedure TfmMain.FormShow(Sender: TObject);
var
ServFull, ServAddr, ServPort, ServPass: String;
NewServer: String;
begin
//SetProcessAffinityMask(GetCurrentProcess(),1);
lbServers.DoubleBuffered:= true;
lbPlayers.DoubleBuffered:= true;
lbRules.DoubleBuffered:= true;
lbServers.SetFocus;
if ParamCount > 0 then begin
ServFull:= ParamStr(1);
if Copy(ServFull, 0, 7) = 'samp://' then begin
if ParamCount > 1 then
ServPass:= ParamStr(2);
ServFull:= StringReplace(ServFull, 'samp://', '', [rfReplaceAll, rfIgnoreCase]);
ServFull:= StringReplace(ServFull, '/', '', [rfReplaceAll, rfIgnoreCase]);
if Pos(':', ServFull) <> 0 then begin
ServAddr:= Copy(ServFull, 0, Pos(':', ServFull)-1);
///////////////////////////////////////////////
//
// Delphi 7 compiler bug(?)
//
// With this structure:
// ServPort:= IntToStr(StrToIntDef(Copy(ServFull, Pos(':', ServFull)+1, Length(ServFull)-Pos(':', ServFull)+1), 7777));
// the compiler seems to gets confused and will not generate
// LStrLAsg call after Sysutils::IntToStr to set ServPort variable.
// Workaround is to break down the structure.
//
///////////////////////////////////////////////
ServPort:= Copy(ServFull, Pos(':', ServFull)+1, Length(ServFull)-Pos(':', ServFull)+1);
ServPort:= IntToStr(StrToIntDef(ServPort, 7777));
end else begin
ServAddr:= Copy(ServFull, 0, Length(ServFull));
ServPort:= '7777';
end;
wnd_webrunform.Label1.Caption:= 'Do you want to add ' + ServAddr + ':' + ServPort + ' to your favorites ' + #13#10 + 'or play on this server now?';
Case wnd_webrunform.ShowModal Of
mrOk: begin
ServerConnect(ServAddr, ServPort, ServPass);
Application.Terminate;
end;
mrYes: begin
sub_4E1CEC;
NewServer:= ServAddr + ':' + ServPort;
if InputQuery('Add Server', 'Enter new server HOST:PORT...', NewServer) <> False then
if NewServer <> '' then
AddServer(NewServer);
end;
mrCancel: ;
end;
end else begin
ServFull:= ParamStr(1);
if ParamCount > 1 then
ServPass:= ParamStr(2);
if Pos(':', ServFull) <> 0 then begin
ServAddr:= Copy(ServFull, 1, Pos(':', ServFull)-1);
ServPort:= IntToStr(StrToIntDef(Copy(ServFull, Pos(':', ServFull)+1, 5), 7777));
end else begin
ServAddr:= ServFull;
ServPort:= '7777';
end;
ServerConnect(ServAddr, ServPort, ServPass);
Application.Terminate;
end;
end;
sub_4E1CEC;
end;
function BrowseCallbackProc(hwnd: HWND; uMsg: UINT; lParam, lpData: LPARAM): Integer; stdcall;
begin
case uMsg of
BFFM_INITIALIZED:
Begin
SetWindowText(hWnd, 'GTA: San Andreas Installation');
SendMessage(hwnd, BFFM_SETSELECTION, 1, lpData);
End;
end;
Result:= 0;
end;
function TfmMain.BrowseForFolder(Owner: HWND; var Directory: String; StartDir, Title: String): Boolean;
var
BrowseInfo: TBrowseInfo;
DisplayName: Array[0..MAX_PATH] Of Char;
TempPath : Array[0..MAX_PATH] Of Char;
begin
Result:= False;
FillChar(BrowseInfo, SizeOf(TBrowseInfo), #0);
With BrowseInfo Do Begin
hwndOwner:= Owner;
pidlRoot:= nil;
pszDisplayName:= @DisplayName;
lpszTitle:= PChar(Title);
ulFlags:= BIF_RETURNONLYFSDIRS;
lParam:= Integer(PChar(StartDir));
lpfn:= BrowseCallbackProc;
End;
If SHGetPathFromIDList(SHBrowseForFolder(BrowseInfo), TempPath) Then Begin
Directory:= TempPath;
Result:= True;
End;
end;
procedure TfmMain.miSampClick(Sender: TObject);
begin
ShellExecute(Handle, 'open', 'http://www.sa-mp.com/', nil, nil, SW_SHOWNORMAL);
end;
procedure TfmMain.tmrQueryQueueProcessTimer(Sender: TObject);
begin
//Application.ProcessMessages;
if QueryQueue.Count > 0 then begin
QueryServerInfo(QueryQueue.Strings[0], false, true, false, false);
//QueryServerInfo(QueryQueue.Strings[0], true, false, false, false);
//UpdateServers;
QueryQueue.Delete(0);
end;
end;
procedure TfmMain.label_urlClick(Sender: TObject);
begin
ShellExecute(0, 'open', PAnsiChar('http://' + (Sender as TLabel).Caption), '', '', SW_SHOWNORMAL);
end;
procedure TfmMain.CreateFASTDesktoplink1Click(Sender: TObject);
var
Idx: Integer;
begin
if lbServers.ItemIndex = -1 then Exit;
Idx:= StrToInt(lbServers.Items.Strings[lbServers.ItemIndex]);
if Idx >= Length(Servers) then Exit;
sub_4E1E6C(Servers[Idx].Address + ':' + IntToStr(Servers[Idx].Port), Servers[Idx].HostName);
end;
procedure TfmMain.FormResize(Sender: TObject);
begin
imLogo.Left:= fmMain.Width - imLogo.Width;
imLogo.Repaint;
end;
procedure TfmMain.imLogoClick(Sender: TObject);
begin
fmAbout.ShowModal;
end;
end.
Reference in New Issue View Git Blame Copy Permalink