summaryrefslogtreecommitdiff
path: root/orig/pq/SelServ.pas
blob: 5871383afa7c098ce9403e66779ee666247e5ef8 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
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.