From 14a6aa4c488bcd2d49103cbee1424b2769d77ce0 Mon Sep 17 00:00:00 2001 From: Dimitri Sokolyuk Date: Fri, 12 Aug 2016 14:05:45 +0200 Subject: Initial import --- orig/pq/SelServ.pas | 184 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 184 insertions(+) create mode 100644 orig/pq/SelServ.pas (limited to 'orig/pq/SelServ.pas') diff --git a/orig/pq/SelServ.pas b/orig/pq/SelServ.pas new file mode 100644 index 0000000..5871383 --- /dev/null +++ b/orig/pq/SelServ.pas @@ -0,0 +1,184 @@ +unit SelServ; +{ copyright (c)2002 Eric Fredricksen all rights reserved } + +interface + +uses + Windows, Messages, SysUtils, Forms, Dialogs, StdCtrls, ExtCtrls, + ComCtrls, Controls, Classes; + +type + TServerSelectForm = class(TForm) + Servers: TListBox; + Label1: TLabel; + Label2: TLabel; + Panel1: TPanel; + Desc: TRichEdit; + Select: TButton; + Button2: TButton; + Descs: TListBox; + Timer1: TTimer; + Hosts: TListBox; + Options: TListBox; + AccessCode: TLabeledEdit; + procedure ServersClick(Sender: TObject); + procedure SelectClick(Sender: TObject); + procedure AccessCodeChange(Sender: TObject); + procedure Timer1Timer(Sender: TObject); + procedure ServersDblClick(Sender: TObject); + private + procedure Fetch(path: String); + function CurrentOpts: Integer; + procedure ParseServerList(body: String); + public + function Go: Boolean; + end; + +var + ServerSelectForm: TServerSelectForm; + +function Take(var s: String): String; + +implementation + +uses NewGuy, Login, Main, Web; + +{$R *.dfm} + +function Take(var s: String): String; +begin + if Pos('|',s) > 0 then begin + Result := Trim(Copy(s,1,Pos('|',s)-1)); + s := Copy(s,Pos('|',s)+1,100000); + end else begin + Result := Trim(s); + s := ''; + end; +end; + +procedure TServerSelectForm.ParseServerList(body: String); +var + s, def: String; + ndef: Integer; +begin + s := body; + if (LowerCase(Take(s)) = 'ok') then begin + def := Take(s); + ndef := 0; + repeat + Servers.Items.Add(Take(s)); + if Servers.Items[Servers.Count-1] = def then + ndef := Servers.Count-1; + Options.Items.Add(Take(s)); + Hosts.Items.Add(Take(s)); + Descs.Items.Add(Take(s)); + until s = ''; + Servers.ItemIndex := ndef; + ServersClick(Self); + // Select.Enabled := true; + end else begin + ShowMessage(body); + ModalResult := mrCancel; + end; +end; + +procedure TServerSelectForm.ServersClick(Sender: TObject); +begin + Desc.Lines.Text := Descs.Items[Servers.ItemIndex]; + AccessCode.Visible := (CurrentOpts and 8) > 0; + AccessCodeChange(Sender); +end; + +function TServerSelectForm.CurrentOpts: Integer; +begin + Result := StrToIntDef(Options.Items[Servers.ItemIndex],0); +end; + +procedure TServerSelectForm.Fetch(path: String); +var + url, reply: String; +begin + Select.Enabled := false; + Servers.Items.Clear; + Descs.Items.Clear; + Options.Items.Clear; + Hosts.Items.Clear; + Caption := 'Progress Quest - Select Realm'; + if path <> '' then + Caption := Caption + ' [' + path + ']'; + Desc.Text := 'Fetching realm list from server...'; + url := 'http://www.progressquest.com/list.php?' + RevString + '&p=' + path; + if AccessCode.Visible then + url := url + '&ac=' + UrlEncode(AccessCode.Text); + try + Screen.Cursor := crHourglass; + try + reply := DownloadString(url); + ParseServerList(reply); + except + on EWebError do begin + ShowMessage('Error connecting to Progress Quest server'); + ModalResult := mrCancel; + end; + end; + finally + Screen.Cursor := crDefault; + end; +end; + +function TServerSelectForm.Go: Boolean; +begin + Timer1.Enabled := true; + Result := //(Servers.Count > 0) and + (mrOk = ShowModal); +end; + +function ServerURL(user, pass, host, uri: String): String; +begin + if Pos(uri, '?') > 0 then uri := uri + '&' else uri := uri + '?'; + uri := uri + 'rev=3'; + Result := 'http://' + user + ':' + pass + '@' + host + uri; +end; + +procedure TServerSelectForm.AccessCodeChange(Sender: TObject); +begin + Select.Enabled := + (CurrentOpts and 32 = 0) and + (Servers.Count > 0) and ( + (not AccessCode.Visible) or + (AccessCode.Text <> '')); +end; + +procedure TServerSelectForm.SelectClick(Sender: TObject); +begin + // 1: account required to create char + // 2: password required to create char + // 4: is a dir + // 8: password required to select + // 16: use progressquest.com for creates! + // 32: disable it! + if (CurrentOpts and 4) > 0 then begin + Fetch(Hosts.Items[Servers.ItemIndex]); + end else begin + MainForm.SetHostAddr(Hosts.Items[Servers.ItemIndex]); + MainForm.SetHostName(Servers.Items[Servers.ItemIndex]); + MainForm.Label8.Tag := CurrentOpts; + NewGuyForm.Account.Visible := (CurrentOpts and 1) > 0; + NewGuyForm.Password.Visible := (CurrentOpts and 2) > 0; + if MainForm.RollCharacter then + ModalResult := mrOk; + end; +end; + +procedure TServerSelectForm.Timer1Timer(Sender: TObject); +begin + Timer1.Enabled := false; + Fetch(''); +end; + +procedure TServerSelectForm.ServersDblClick(Sender: TObject); +begin + if Select.Enabled then SelectClick(Self); +end; + +end. -- cgit v1.2.3