unit SelMirSrvDlg;

{$WARN UNIT_PLATFORM OFF}
{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Forms,Windows, SysUtils, Dialogs, Classes, Controls, StdCtrls, Buttons, ComCtrls,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP,
  _httpvdskconst, Graphics;

type
  TSelMirSrv = class(TForm)
    SrvLst: TListBox;
    OKBtn: TBitBtn;
    CancelBtn: TBitBtn;
    procedure SrvLstDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure OKBtnClick(Sender: TObject);
    procedure CancelBtnClick(Sender: TObject);
    procedure SrvLstDblClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    { Private 宣言 }
    ServerCount:integer;
    Server:array of TServer;
    X68kAnkFontBM:TBitmap;
    procedure PreInitForX68kAnkFont;
    procedure WriteX68kString(dstbm:TBitmap;x,y:integer;Text:String;col:dword);
  public
    { Public 宣言 }
    QDAFilename:string;
    MirrorHost:string;
    MirrorPort:integer;
    RetryFlag:boolean;
    ChgSrvLst:boolean;
    procedure Init(msg:string);
    procedure FreeMemory;
    procedure LoadServerList;
  end;

var
  SelMirSrv: TSelMirSrv;

implementation

uses _fsTools, _PicTools, _netconst;

{$R *.dfm}

const ColMask:dword=$d08080;
const ColBright:dword=$ffc0c0;
const ColText:dword=$ffffff;
const ColBG:dword=$000000;
const ColGraph0:dword=$f0a0a0;
const ColGraph1:dword=$a06060;

procedure TSelMirSrv.PreInitForX68kAnkFont;
begin
  X68kAnkFontBM:=TBitmap.Create;
  LoadBitmapFromQDA(QDAFilename,'X68kAnkFont.bmp',X68kAnkFontBM);
  X68kAnkFontBM.PixelFormat:=pf8bit;
end;

procedure TSelMirSrv.WriteX68kString(dstbm:TBitmap;x,y:integer;Text:String;col:dword);
var
  AnkList:string;
  cnt:integer;
  px:integer;
  wx,wy:integer;
  c,cr,cb,cg:dword;
  msl,dsl:PByteArray;
  offset:integer;
begin
  AnkList:='';
  for cnt:=ord(' ') to ord('~')+1 do begin
    AnkList:=AnkList+char(cnt);
  end;

  cb:=col and $ff;
  cg:=(col shr 8) and $ff;
  cr:=(col shr 16) and $ff;

  cnt:=0;
  while (cnt<Length(Text)) do begin
    if isAnkChar(byte(Text[cnt+1]))=True then begin
      px:=pos(Text[cnt+1],AnkList);
      if px<>0 then begin
        for wy:=0 to 15-1 do begin
          msl:=X68kAnkFontBM.ScanLine[wy];
          dsl:=dstbm.ScanLine[y+wy];
          for wx:=0 to 8-1 do begin
            c:=msl[((px-1)*8)+wx];
            if c=$ff then begin
              offset:=(x+cnt*8)*3+(wx*3);
              dsl[offset+0]:=cr;
              dsl[offset+1]:=cg;
              dsl[offset+2]:=cb;
            end;
          end;
        end;
        end else begin
        dstbm.Canvas.TextOut(x+cnt*8,y,Text[cnt+1]);
      end;
      inc(cnt,1);
      end else begin
      if (cnt+1)<Length(Text) then begin
        dstbm.Canvas.TextOut(x+cnt*8,y,Text[cnt+1]+Text[cnt+2]);
      end;
      inc(cnt,2);
    end;
  end;
end;

procedure TSelMirSrv.Init(msg:string);
begin
  QDAFilename:=ExtractFilePath(Application.ExeName)+'MDXWin.qda';
  if FileExists(QDAFilename)=False then QDAFilename:=ExtractFilePath(Application.ExeName)+'MDXAss.qda';
  PreInitForX68kAnkFont;

  SelMirSrv.Color:=ColBG;

  SrvLst.Clear;
  SrvLst.ItemHeight:=(16*2)+(4*2)+4;
  ChgSrvLst:=False;

  ServerCount:=0;
  SetLength(Server,ServerCount);
  MirrorHost:='';
  MirrorPort:=0;

  SelMirSrv.Caption:=msg;
  RetryFlag:=False;
end;

procedure TSelMirSrv.FreeMemory;
begin
  X68kAnkFontBM.Free;

  SrvLst.Clear;

  ServerCount:=0;
  SetLength(Server,ServerCount);
end;

procedure TSelMirSrv.LoadServerList;
var
  fs:TFileStream;
  IdHTTP:TIdHTTP;
  res:string;
  DataFilename:string;
  cnt:integer;
  BreakFlag:boolean;
  procedure SetHTTPParams(_Host:string;_Port:integer;_URL:string);
  begin
    with IdHTTP do begin
      AllowCookies:=False;
      ASCIIFilter:=False;
      HandleRedirects:=False;
      Host:=_Host;
      Port:=_Port;
      ProtocolVersion:=pv1_0;
      ReadTimeout:=5*1000;
      RecvBufferSize:=8192;
      SendBufferSize:=8192;

      ProxyParams.ProxyPort:=0;
      ProxyParams.ProxyServer:='';

      Request.Host:=_Host;
      Request.URL:=_URL;
    end;
  end;
begin
  BreakFlag:=False;
  DataFilename:='serverlist.dat';

  IdHTTP:=nil;
  fs:=nil;
  try
    IdHTTP:=TIdHTTP.Create(nil);
    SetHTTPParams('home.att.ne.jp',80,'/blue/moonlight/'+DataFilename);
    res:=IdHTTP.Get(IdHTTP.Request.URL);
    fs:=TFileStream.Create(DataFilename,fmCreate or fmShareExclusive);
    fs.WriteBuffer(res[1],length(res));
    except else begin
      ShowMessage('ミラーサーバリストが取得できませんでした。'+CRLF+'しばらくしてから再試行してください。');
      RetryFlag:=False;
      ModalResult:=mrCancel;
      BreakFlag:=True;
    end;
  end;
  fs.Free;
  IdHTTP.Free;
  if BreakFlag=True then exit;

  fs:=nil;
  try
    fs:=TFileStream.Create(DataFilename,fmOpenRead or fmShareExclusive);
    ServerCount:=GetStreamWord(fs);
    SetLength(Server,ServerCount);
    for cnt:=0 to ServerCount-1 do begin
      with Server[cnt] do begin
        Host:=GetStreamMString(fs);
        Port:=GetStreamWord(fs);
        UpLink:=GetStreamMString(fs);
        RegDate:=GetStreamDateTime(fs);
        ServerVer:=GetStreamMString(fs);
        DataBaseVer:=GetStreamMString(fs);
      end;
    end;
    except else begin
      ShowMessage('ミラーサーバリストが異常です。'+CRLF+'しばらくしてから再試行してください。');
      RetryFlag:=False;
      ModalResult:=mrCancel;
      BreakFlag:=True;
    end;
  end;
  fs.Free;
  if BreakFlag=True then exit;

  DeleteFile(DataFilename);

  ChgSrvLst:=True;
  SrvLst.Clear;
  for cnt:=0 to ServerCount-1 do begin
    SrvLst.Items.Add(inttostr(cnt));
  end;
  ChgSrvLst:=False;
  SrvLst.Refresh;

  if ServerCount=0 then begin
    ShowMessage('ミラーサーバが一つも見つかりませんでした。');
    RetryFlag:=False;
    ModalResult:=mrCancel;
    BreakFlag:=True;
  end;
  if BreakFlag=True then exit;
end;

procedure TSelMirSrv.SrvLstDrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  date:string;
  msg0,msg1:string;
  fcol:dword;
  procedure DrawBM(dx,dy:integer;msg:string);
  var
    x,y:integer;
    bm:TBitmap;
  begin
    x:=(length(msg)+1)*8;
    y:=16;
    bm:=TBitmap.Create;
    MakeBlankBM(bm,x,y,pf24bit);
    with (Control as TListBox).Canvas do begin
      bm.Canvas.Brush.Style:=Brush.Style;
      bm.Canvas.Brush.Color:=Brush.Color;
      bm.Canvas.FillRect(Bounds(0,0,x,y));
      WriteX68kString(bm,0,0,msg,fcol);
      BitBlt(Handle,Rect.Left+2+4+dx,Rect.Top+2+4+dy,length(msg)*8,16,bm.Canvas.Handle,0,0,SRCCOPY);
    end;
    bm.Free;
  end;
begin
  if ChgSrvLst=True then exit;

  with (Control as TListBox).Canvas do begin
    Brush.Style:=bsSolid;
    if (odSelected in State) then begin
      Brush.Color:=ColMask;
      fcol:=ColText;
      end else begin
      Brush.Color:=ColBG;
      fcol:=ColBright;
    end;
    FillRect(Rect);

    if Index<ServerCount then begin
      with Server[Index] do begin
        date:=FormatDateTime('[yyyy/mm/dd hh:nn:ss]',RegDate);
        msg0:=format('%-30s [UpLink:%s]',[Host+':'+inttostr(Port),UpLink]);
        msg1:=format('%-21s [%s,%s]',[date,ServerVer,DataBaseVer]);
      end;
      DrawBM(0,16*0,msg0);
      DrawBM(0,16*1,msg1);
	  end;

    Pen.Color:=ColGraph1;
    Pen.Style:=psSolid;
    MoveTo(Rect.Left,Rect.Bottom-1);
    LineTo(Rect.Right,Rect.Bottom-1);
  end;
end;

procedure TSelMirSrv.OKBtnClick(Sender: TObject);
begin
  if SrvLst.ItemIndex=-1 then begin
    MirrorHost:='';
    MirrorPort:=0;
    RetryFlag:=False;
    ModalResult:=mrCancel;
    exit;
  end;

  if SrvLst.ItemIndex<ServerCount then begin
    with Server[SrvLst.ItemIndex] do begin
      MirrorHost:=Host;
      MirrorPort:=Port;
    end;
  end;

  if ((MirrorHost<>'') and (MirrorPort<>0)) then begin
    RetryFlag:=True;
    ModalResult:=mrOK;
    end else begin
    MirrorHost:='';
    MirrorPort:=0;
    RetryFlag:=False;
    ModalResult:=mrCancel;
  end;
end;

procedure TSelMirSrv.CancelBtnClick(Sender: TObject);
begin
  MirrorHost:='';
  MirrorPort:=0;

  RetryFlag:=False;
  ModalResult:=mrCancel;
end;

procedure TSelMirSrv.SrvLstDblClick(Sender: TObject);
begin
  OKBtnClick(Sender);
end;

procedure TSelMirSrv.FormResize(Sender: TObject);
begin
  CancelBtn.Left:=SelMirSrv.ClientWidth-8-CancelBtn.Width;
  OKBtn.Left:=CancelBtn.Left-8-OKBtn.Width;
  SrvLst.Width:=SelMirSrv.ClientWidth;

  OKBtn.Top:=SelMirSrv.ClientHeight-8-OKBtn.Height;
  CancelBtn.Top:=OKBtn.Top;
  SrvLst.Height:=OKBtn.Top-8;
end;

end.
