unit ddpd;

interface

uses
  Windows, Messages, SysUtils, Classes, Forms,
  dplay, OLE2, StdCtrls, Buttons, Controls, ExtCtrls, Graphics, Dialogs;


type

//デバッグオプション
TDDPDDebugOption = set of (dpoHaltOnError, dpoDebugMessage, dpoExceptOnError);


TDDPDReceiveThread = class(TThread)
  private
    FOwner:TObject;
  public
    REvent:THandle;              //メッセージ受信イベント
    constructor Create(owner:TObject);
    destructor Destroy; override;
    procedure Execute; override;
end;

//一人のプレイヤーの情報を入れるクラス
TDDPDPlayer = class(TObject)
  private
    FID:DPID;
    FShortName:String;
    FLongName:String;
  public
    constructor Create(myID:DPID; lName,sName:String);
    property ID:DPID read FID;
    property LongName:String read FLongName;
    property ShortName:String read FShortName;
end;

//プレイヤー郡を管理するクラス
TDDPDPlayers = class(TList)
  private
  public
    function Find(id:DPID):TDDPDPlayer;
    function FindIndex(id:DPID):Integer;
    procedure AssignToStrings(dest:TStrings);  //邪道だけど…TStringsへの代入
    destructor Destroy; override;
end;


TDDPDPlayerEvent = procedure(Sender:TObject; player:TDDPDPlayer; ShortName,LongName:String) of object;
TDDPDMessageEvent = procedure(Sender:TObject; from:TDDPDPlayer; data:Pointer; dataSize:DWord) of object;

//サービスプロバイダ・セッション・グループの一覧を管理をするクラス
TDDPD = class(TComponent)
  private
    FDplay:IDirectPlay3;        //DirectPlayインターフェイス
    FServiceProviders:TStrings; //サービスプロバイダ
    FSessions:TStrings;         //現在使用しているサービスプロバイダにあるセッションのリスト
    FPlayers:TDDPDPlayers;      //現在のセッションに参加しているプレイヤーのリスト
    FAppGuid:TGUID;             //アプリケーション識別用のGUID
    FConnected:Boolean;         //IDirectPlayオブジェクトが初期化されたか？
    FJoined:Boolean;            //すでにセッションに参加しているか？

    FRThread:TDDPDReceiveThread;  //メッセージ待機スレッド
    FREvent:THandle;              //メッセージ到着イベントのハンドル

    FMyID:DPID;
    FMyPlayer:TDDPDPlayer;        //このコンポーネントが管理するプレイヤー

    FOnArriveMessage:TDDPDMessageEvent;     // アプリ定義メッセージが届いた
    FOnComesNewChallenger:TDDPDPlayerEvent; // Here Comes a New Challenger!!
    FOnEscapeChallenger:TDDPDPlayerEvent;   // プレイヤーがセッションから抜けた
    FSendGuaranteed:Boolean;               //保証付きで送信する

    //セッション作成時のオプション
    FNoMessageID:Boolean;                   //送信者のIDをつけない
    FMaxPlayers:Integer;
    FDebugOption: TDDPDDebugOption;                    //最大参加人数

    //FOnLostSession:TNotifyEvent;            // セッションが無くなった
    //FOnStartSession:TNotifyEvent;           // セッションが作られた

    procedure SetAppGUIDStr(v:String);
    function GetAppGUIDStr:String;

    function CreatePlayer(shortName,longName:String):HRESULT; //プレーヤの作成
    function DeletePlayer:HRESULT;                            //プレーヤの退席
    procedure ReceiveMessage;
    procedure SetDebugOption(const Value: TDDPDDebugOption);                                 //メッセージの受信・ディスパッチ
  public
    constructor Create(AOWner:TComponent); override;
    procedure Loaded; override;
    destructor Destroy; override;
    function Connect(serviceProviderIndex:Integer):HRESULT; //接続

    function Execute:Boolean;                              //ダイアログを表示する

    function InspectSession(sessionIndex:Integer):HRESULT;    //セッションを覗いてプレイヤーのリストだけを得る
    function CreateSession(sessionName:String; shortName,longName:String):HRESULT; //セッションの作成・プレイヤーの作成
    function JoinSession(sessionIndex:Integer; shortName,longName:String):HRESULT;  //セッションへの参加・プレイヤーの作成
    function CloseSession:HRESULT;

    function Send(toID:DPID; data:Pointer; dataSize:DWord):HRESULT;

    property ServiceProviders:TStrings read FServiceProviders;
    property Sessions:TStrings read FSessions;
    property Players:TDDPDPlayers read FPlayers;
    property MyPlayer:TDDPDPlayer read FMyPlayer;

  published
    property DebugOption:TDDPDDebugOption read FDebugOption write SetDebugOption;

    property AppGuid:String read GetAppGUIDStr write SetAppGUIDStr;
    property SendGuaranteed:Boolean read FSendGuaranteed write FSendGuaranteed default true;

    property MaxPlayers:Integer read FMaxPlayers write FMaxPlayers default 4;         //セッションへの最大参加人数
    property NoMessageID:Boolean read FNoMessageID write FNoMessageID default False;  //メッセージIDをつけない
    property OnArriveMessage:TDDPDMessageEvent read FOnArriveMessage write FOnArriveMessage;
    property OnComesNewChallenger:TDDPDPlayerEvent read FOnComesNewChallenger write FOnComesNewChallenger;
    property OnEscapeChallenger:TDDPDPlayerEvent read FOnEscapeChallenger write FOnEscapeChallenger;
    //property OnLostSession:TNotifyEvent read FOnLostSession write FOnLostSession;
    //property OnStartSession:TNotifyEvent read FOnStartSession write FOnStartSession;

end;


type TDDPDAnimationThread = class;


//簡単接続ダイアログ
TDDPDForm = class(TForm)
    Label1: TLabel;
    ServiceProviderBox: TComboBox;
    GroupBox1: TGroupBox;
    SessionList: TListBox;
    GroupBox2: TGroupBox;
    PlayerList: TListBox;
    Label2: TLabel;
    PlayerNameEdit: TEdit;
    CancelBtn: TBitBtn;
    NewSessionBtn: TButton;
    JoinSessionBtn: TButton;
    Bevel1: TBevel;
    PaintBox1: TPaintBox;
    Image1: TImage;
    procedure FormShow(Sender: TObject);
    procedure SessionListClick(Sender: TObject);
    procedure ServiceProviderBoxChange(Sender: TObject);
    procedure PlayerNameEditChange(Sender: TObject);
    procedure NewSessionBtnClick(Sender: TObject);
    procedure JoinSessionBtnClick(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
  private
    { Private 宣言 }
    AnimeThread:TDDPDAnimationThread;
    FFrame:Integer;   //アニメーションのフレーム
  public
    { Public 宣言 }
    Connector:TDDPD; //接続に用いるDDPDコンポーネント
end;

//ウィンドウの右上のアニメーション用
TDDPDAnimationThread = class(TThread)
  private
    FOwner:TDDPDForm;
  public
    constructor Create(Owner:TDDPDForm);
    destructor Destroy; override;
    procedure Execute; override;
end;

procedure Register;


implementation




{$R *.DFM}

(****************************************************************************
 *
 * デバッグ用(TDDPD.DebugOptionで制御)
 *
 ****************************************************************************)
var
  DDPD_HaltOnError:Boolean;        {エラーが起きたらすぐにHaltする}
  DDPD_DebugMessage:Boolean;       {デバッグメッセージをファイルに書き出す}
  DDPD_ExceptOnError:Boolean;      {エラーが起きたら例外を発生する}


(****************************************************************************
  登録
 ****************************************************************************)
procedure Register;
begin
  RegisterComponents('Quadruple D',[TDDPD]);
end;


(******************************************************************************
  デバッグ補助関数
******************************************************************************)
type
  EDDPD = class(Exception);
var
  DebugCount:Integer = 0;
  ErrDDPD:EDDPD;       //例外オブジェクト

procedure PutDebugMessage(mes:String);
var
  F:TextFile;
  fname:String;
begin
  //デバッグメッセージの出力が禁止になっているなら、何もしない
  if DDPD_DebugMessage then begin

    //EXEファイルのあるディレクトリのdddd.debugというファイルに一行書き込む
    fname:=ExtractFilePath(Application.Exename) + 'DDPD.debug';

    //ファイルを開く
    AssignFile(F,fname);
    //もし、プログラムの実行後、はじめての書き込みなら、ファイルをクリア
    if debugCount = 0 then
      ReWrite(F)
    else
      Append(F);

    Inc(debugCount);

    //一行書き込む
    Writeln(F,Format('debug#%.5d ... %s',[debugCount,mes]));

    //ファイル閉じる
    CloseFile(F);
  end;

  //例外の発生がOnなら、例外を発生させる
  if DDPD_ExceptOnError then begin
    ErrDDPD:=EDDPD.Create(mes);
    raise ErrDDPD;
  end;
end;

function TRYDP(err:HRESULT; failMes:String):HRESULT;
begin
  result:=err;

  if (err = HRESULT(DP_OK)) Or (err = HRESULT(DPERR_USERCANCEL)) then
    exit;

	PutDebugMessage(failMes+Format('(Error Code(%x))',[err]));

  if DDPD_HaltOnError then
    Halt; //安全のため、Haltしちゃう

end;




(******************************************************************************
  各種列挙用コールバック関数
******************************************************************************)
function EnumConnectionsCallBack(lpguidSP: LPDPNAME; lpConnection: Pointer;
	 dwConnectionSize: DWORD; lpName: LPDPNAME; dwFlags: DWORD; lpContext: Pointer): BOOL; stdcall;
var
  s:TStrings;
  g:Pointer;
begin
  s:=lpContext;

  getmem(g,dwConnectionSize);
  Move(lpConnection^,g^,dwConnectionSize);

  s.AddObject(lpName.lpszShortNameA,g);
  Result:=True;

end;

function EnumSessionsCallBack(lpThisSD: LPCDPSESSIONDESC2; lpdwTimeOut: LPDWORD;
	 dwFlags: DWORD; lpContext: Pointer): BOOL; stdcall;
var
  s:TStrings;
  g:Pointer;
begin
  if lpThisSD = Nil then begin
    result:=False;
    Exit;
  end;

  s:=lpContext;

  getMem(g,sizeof(DPSessionDesc2));
  Move(lpThisSD^,g^,sizeof(DPSessionDesc2));

  s.AddObject(lpThisSD^.lpszSessionNameA,g);
  Result:=True;
end;


function EnumPlayersCallBack(dpId: DWord; dwPlayerType: DWORD; lpName: LPDPNAME;
	 dwFlags: DWORD; lpContext: Pointer): BOOL; stdcall;

var
  s:TDDPDPlayers;
begin
  s:=lpContext;

  s.Add(TDDPDPlayer.Create(dpId,lpName.lpszShortNameA,lpName.lpszLongNameA));

  Result:=True;
end;







(******************************************************************************
  TDDPDPlayerの受信スレッド
******************************************************************************)
constructor TDDPDReceiveThread.Create(owner:TObject);
begin
  inherited Create(True);

  FOwner:=owner;
  FreeOnTerminate:=True;
  REvent:=CreateEvent(Nil,False,False,Nil);
end;

destructor TDDPDReceiveThread.Destroy;
begin
  inherited;
end;

procedure TDDPDReceiveThread.Execute;
begin

  while WaitForSingleObject(TDDPD(FOwner).FREvent,INFINITE) = WAIT_OBJECT_0 do begin
    Synchronize(TDDPD(FOwner).ReceiveMessage);
  end;
end;









(******************************************************************************
  TDDPDPlayer , Players
******************************************************************************)

//プレイヤー情報の代入
constructor TDDPDPlayer.Create(myID:DPID; lName,sName:String);
begin
  inherited Create;

  FID:=myID;
  FLongName:=lName;
  FShortname:=sName;
end;

//プレイヤーリストの消去
destructor TDDPDPlayers.Destroy;
begin

  While Count > 0 do begin
    TDDPDPlayer(Items[Count-1]).Free;
    Delete(Count-1);
  end;

  inherited;
end;

//文字列リストにPlayerの名前リストを代入する手続き
procedure TDDPDPlayers.AssignToStrings(dest:TStrings);
var
  ds:TStrings;
  i:Integer;
begin
  ds:=TStrings(dest);
  ds.Clear;
  for i:=0 to Count-1 do begin
    ds.Add(TDDPDPlayer(Items[i]).ShortName);
  end;
end;

//IDからプレイヤーを検索
function TDDPDPlayers.Find(id:DPID):TDDPDPlayer;
var
  i:Integer;
begin
  result:=Nil;

  For i:=0 to Count-1 do begin
    if TDDPDPlayer(Items[i]).ID = id then begin
      result:=Items[i];
    end;
  end;
end;

//IDからリスト内のインデックスを検索
function TDDPDPlayers.FindIndex(id:DPID):Integer;
var
  i:Integer;
begin
  result:=-1;

  For i:=0 to Count-1 do begin
    if TDDPDPlayer(Items[i]).ID = id then begin
      result:=i;
    end;
  end;
end;


(******************************************************************************
  TDDPD本体
******************************************************************************)
constructor TDDPD.Create(AOwner:TComponent);
begin
  inherited;

  //DDPDコンポが同一フォームに張りつけられてないか、チェック
  {
  if (csDesigning in ComponentState) then begin
    count:=0;
    for i:=0 to Owner.ComponentCount-1 do begin
      if Owner.Components[i] is TDDPD then begin
        Inc(count);
      end;
    end;

    if count >=2 then begin
      raise Exception.Create('DDPDコンポーネントを、同一フォームに2つ以上貼る事はできません');
      exit;
    end;
  end;
  }

  //プロパティの初期化
  FServiceProviders:=Nil;
  FSessions:=Nil;
  FPlayers:=Nil;
  FAppGuid:=GUID_NULL;
  FConnected:=False;
  FJoined:=False;
  SendGuaranteed:=True;

  NoMessageID:=False;
  MaxPlayers:=4;

  DebugOption:=[dpoHaltOnError];
end;

procedure TDDPD.Loaded;
begin
  inherited;

  if not (csDesigning in ComponentState) then begin
    //ここに初期化ルーチン

    //プロパティのリフレッシュ
    DebugOption:=DebugOption;

    //DirectPlayオブジェクトの作成
    CoCreateInstance(CLSID_DirectPlay, Nil, CLSCTX_INPROC_SERVER, IID_IDirectPlay3A, FDPlay);

    //サービスプロバイダ一覧の作成
    FServiceProviders:=TStringList.Create;
    FDplay.EnumConnections(@FAppGUID, EnumConnectionsCallBack, FServiceProviders, DPCONNECTION_DIRECTPLAY);

  end;

end;

destructor TDDPD.Destroy;
begin

  if not (csDesigning in ComponentState) then begin
    if Assigned(FDPlay) then
      FDplay.Release;
  end;

  inherited;
end;


//デバッグオプション
procedure TDDPD.SetDebugOption(const Value: TDDPDDebugOption);
begin
  FDebugOption := Value;

  DDPD_DebugMessage := dpoDebugMessage in Value;
  DDPD_ExceptOnError := dpoExceptOnError in Value;
  DDPD_HaltOnError := dpoHaltOnError in Value;
end;



//接続
function TDDPD.Connect(ServiceProviderIndex:Integer):HRESULT;
var
  sd:DPSESSIONDESC2;
  i:Integer;
begin

  //接続済みの場合、色々と処置
  if FConnected then begin
    if FJoined then begin
      CloseSession;
      FJoined:=False;
    end;
    FDPlay.Release;

    CoCreateInstance(CLSID_DirectPlay, Nil, CLSCTX_INPROC_SERVER, IID_IDirectPlay3A, FDPlay);
    //サービスプロバイダ一覧の作成
    FServiceProviders:=TStringList.Create;
    FDplay.EnumConnections(@FAppGUID, EnumConnectionsCallBack, FServiceProviders, DPCONNECTION_DIRECTPLAY);
  end;

  result := FDplay.InitializeConnection(Pointer(FServiceProviders.Objects[ServiceProviderIndex]), 0);

  if result <> DP_OK then begin
    if DDPD_DebugMessage then begin
      PutDebugMessage(FServiceProviders[ServiceProviderIndex] + 'に接続できません' + Format('%.8x',[result]));
      Exit;
    end;
  end;

  //一応、DirectPlayオブジェクトは初期化されたわけだ
  FConnected:=True;

  //セッションの列挙
  if Assigned(FSessions) then begin
    For i:=0 to FSessions.Count-1 do
      FreeMem(Pointer(FSessions.Objects[i]));
    FSessions.Free;
  end;
  FSessions:=TStringList.Create;

  ZeroMemory(@sd,sizeof(DPSessionDesc2));
  sd.dwSize:=sizeof(DPSessionDesc2);
  sd.guidApplication:=FAppGUID;

  TRYDP(FDplay.EnumSessions(@sd, 0, EnumSessionsCallBack, FSessions, DPENUMSESSIONS_AVAILABLE),'セッションの列挙に失敗しました');
end;


//セッションを覗き見する…プレイヤーは作成せず、プレイヤーのリストだけを得る
function TDDPD.InspectSession(sessionIndex:Integer):HRESULT;
begin
  //すでにセッションが開いているなら、それを閉じる
  if FJoined then
    CloseSession;

  //セッションのオープン
  result:=TRYDP(FDplay.Open(Pointer(FSessions.Objects[sessionIndex]),DPOPEN_JOIN),'セッションのオープンに失敗しました');

  if result <> DP_OK then
    Exit;

  FJoined:=True;

  //プレイヤーの列挙
  if Assigned(FPlayers) then
    FPlayers.Free;
  FPlayers:=TDDPDPlayers.Create;

  result:=TRYDP(FDplay.EnumPlayers(Nil, EnumPlayersCallBack, FPlayers, DPENUMPLAYERS_ALL),'プレイヤーの列挙に失敗しました');
  if result <> DP_OK then
    Exit;

  //セッションのクローズ
  result:=TRYDP(FDplay.Close,'セッションのクローズに失敗しました');

  FJoined:=False;
end;



//セッションの作成
function TDDPD.CreateSession(sessionName:String; shortName,longName:String):HRESULT;
var
  sd:DPSESSIONDESC2;
begin
  //すでにセッションが開いているなら、それを閉じる
  if FJoined then
    CloseSession;

  ZeroMemory(@sd,sizeof(DPSessionDesc2));
  sd.dwSize:=sizeof(DPSessionDesc2);
  sd.guidApplication:=FAppGUID;
  sd.dwFlags:=DPSESSION_MIGRATEHOST Or DPSESSION_KEEPALIVE;
  sd.dwMaxPlayers:=FMaxPlayers;

  if sessionName = '' then
    sd.lpszSessionNameA:=Nil
  else
    sd.lpszSessionNameA:=PChar(sessionName);

  //１対１のゲームのように、送り手のIDがいらない場合に
  if FNoMessageID then
    sd.dwFlags:=sd.dwFlags Or DPSESSION_NOMESSAGEID;

  //セッションの作成
  result:=TRYDP(FDplay.Open(@sd,DPOPEN_CREATE),'セッションのオープンに失敗しました');
  if result <> DP_OK then
    Exit;

  FJoined:=True;

  //プレイヤーの列挙
  if Assigned(FPlayers) then
    FPlayers.Free;
  FPlayers:=TDDPDPlayers.Create;

  result:=TRYDP(FDplay.EnumPlayers(Nil, EnumPlayersCallBack, FPlayers, DPENUMPLAYERS_ALL),'プレイヤーの列挙に失敗しました');
  if result <> DP_OK then
    Exit;

  //プレイヤーの作成
  result:=CreatePlayer(shortName,longName);
end;


//既存のセッションを開く
function TDDPD.JoinSession(sessionIndex:Integer; shortName,longName:String):HRESULT;
begin
  //すでにセッションが開いているなら、それを閉じる
  if FJoined then
    CloseSession;

  result:=TRYDP(FDplay.Open(Pointer(FSessions.Objects[sessionIndex]),DPOPEN_JOIN),'セッションのオープンに失敗しました');

  if result <> DP_OK then
    Exit;

  FJoined:=True;

  //プレイヤーの列挙
  if Assigned(FPlayers) then
    FPlayers.Free;
  FPlayers:=TDDPDPlayers.Create;

  result:=TRYDP(FDplay.EnumPlayers(Nil, EnumPlayersCallBack, FPlayers, DPENUMPLAYERS_ALL),'プレイヤーの列挙に失敗しました');
  if result <> DP_OK then
    Exit;

  //プレイヤーの作成
  result:=CreatePlayer(shortName,longName);
end;


//セッションをクローズする
function TDDPD.CloseSession:HRESULT;
begin
  //プレーヤの削除
  result:=DeletePlayer;
  if result <> DP_OK then
    Exit;

  //セッションのクローズ
  result:=TRYDP(FDplay.Close,'セッションのクローズに失敗しました');
end;


//プレーヤの作成…セッションへの参加と同時に生成
function TDDPD.CreatePlayer(shortName,longName:String):HRESULT;
var
  id:DPID;
  name:DPNAME;
  NewP:TDDPDPlayer;
begin

  //イベントの生成
  FREvent:=CreateEvent(Nil,False,False,Nil);

  ZeroMemory(@name,sizeof(name));
  name.dwSize:=sizeof(name);
  name.lpszShortNameA:=Pchar(shortName);
  name.lpszLongNameA:=Pchar(longName);

  result:=TRYDP(FDplay.CreatePlayer(@id,@name, FREvent,Nil,0,0),'プレーヤの作成に失敗しました');

  if result <> DP_OK then
    Exit;

  //メッセージ受信スレッドの初期化
  FRThread:=TDDPDReceiveThread.Create(Self);
  FRThread.Resume;

  FMyID:=id;

  NewP:=TDDPDPlayer.Create(id,shortName,longname);
  FPlayers.add(NewP);
  FMyPlayer:=NewP;

end;


//プレーヤの削除…セッションのクローズと同時に削除
function TDDPD.DeletePlayer:HRESULT;
begin
  //どうせセッションに対してクローズしちゃうので、別にプレーヤの削除はしなくていい。
  //そういうわけで、受信スレッドの終了
  FRThread.Terminate;
  result:=DP_OK;
end;


//メッセージの受信・ディスパッチ
procedure TDDPD.ReceiveMessage;
var
  ret:HRESULT;
  idFrom,idTo:DPID;
  pMsgBuf:LPDPMSG_GENERIC;
  needBufferSize:DWord;
  NewP:TDDPDPlayer;
  DelP:TDDPDPlayer;
begin
  pMsgBuf:=Nil;
  needBufferSize:=0;

  ret:=FDPlay.Receive(@idFrom, @idTo, DPRECEIVE_ALL, pMsgBuf, @needBufferSize);


  if ret = HRESULT(DPERR_BUFFERTOOSMALL) then begin
    ReallocMem(pMsgBuf,needBufferSize);
    ret:=FDPlay.Receive(@idFrom, @idTo, DPRECEIVE_ALL, pMsgBuf, @needBufferSize);
  end;

  if (ret <> DP_OK) then begin
    if (ret <> HRESULT(DPERR_NOMESSAGES)) then
      PutDebugMessage(Format('メッセージの受信時に、エラーが発生しました %.8x',[ret]));
    Exit;
  end;

  //メッセージのディスパッチ
  if idFrom = DPID_SYSMSG then begin
    //システムメッセージ

    if pMsgBuf^.dwType =DPSYS_CREATEPLAYERORGROUP then begin
      //プレイヤーが増えた

      //リストに追加
      NewP:=TDDPDPlayer.Create(LPDPMSG_CREATEPLAYERORGROUP(pMsgBuf)^.dpId,
                               LPDPMSG_CREATEPLAYERORGROUP(pMsgBuf)^.dpnName.lpszShortNameA,
                               LPDPMSG_CREATEPLAYERORGROUP(pMsgBuf)^.dpnName.lpszLongNameA);
      FPlayers.Add(NewP);

      //イベントを呼ぶ
      if Assigned(FOnComesNewChallenger) then
        FOnComesNewChallenger(Self, NewP, NewP.Shortname, NewP.LongName);

    end else if LPDPMSG_GENERIC(pMsgBuf)^.dwType =DPSYS_DESTROYPLAYERORGROUP then begin
      //プレイヤーが減った
      DelP:=TDDPDPlayer(FPlayers.Find(LPDPMSG_DESTROYPLAYERORGROUP(pMsgBuf)^.dpId));
      //先にリストから削除
      FPlayers.Delete(FPlayers.FindIndex(LPDPMSG_DESTROYPLAYERORGROUP(pMsgBuf)^.dpId));

      //イベントを呼ぶ
      if Assigned(FOnEscapeChallenger) then
        FOnEscapeChallenger(Self, DelP, DelP.Shortname, DelP.LongName);

      //実体を削除
      DelP.Free;

    {
    end else if LPDPMSG_GENERIC(pMsgBuf)^.dwType =DPSYS_CHAT then begin
      //チャットメッセージ・・・なんかうまくいかんのよ〜
      if not Assigned(FOnArriveChatMessage) then
        Exit;
      FOnArriveChatMEssage(Self, LPDPMSG_CHAT(pMsgBuf)^.idFromPlayer, LPDPMSG_CHAT(pMsgBuf)^.lpChat^.lpszMessageA);
    }
    end else if LPDPMSG_GENERIC(pMsgBuf)^.dwType = DPSYS_STARTSESSION then begin
      //セッション開始

    end else if LPDPMSG_GENERIC(pMsgBuf)^.dwType = DPSYS_SESSIONLOST then begin
      //セッション終了

    end;
  end else begin
    //アプリ定義のメッセージ
    if not Assigned(FOnArriveMessage) then
      Exit;

    if FNoMessageID then
      FOnArriveMessage(Self, Nil, pMsgBuf, needBufferSize)
    else
      FOnArriveMessage(Self, FPlayers.Find(idFrom), pMsgBuf, needBufferSize);
  end;


  //PutDebugMessage('');
end;



function TDDPD.Send(toID:DPID; data:Pointer; dataSize:DWord):HRESULT;
begin
  if FSendGuaranteed then
    result:=TRYDP(FDPlay.Send(MyPlayer.ID, toID, DPSEND_GUARANTEED, data, dataSize),'メッセージの送信に失敗しました')
  else
    result:=TRYDP(FDPlay.Send(MyPlayer.ID, toID, 0, data, dataSize),'メッセージの送信に失敗しました');
end;


//文字列からGUIDへの変換
procedure TDDPD.SetAppGuidStr(v:String);
var
  g:TGUID;
  i,h,t:Integer;
  rest,cnt:String;
  ex:EDDPD;
  s:String;
begin

  v:=trim(v);

  //長さチェック
  if length(v) = 28 then begin
    ex:=EDDPD.Create(v + 'は無効なプロパティです');
    raise ex;
  end;

  //中括弧のチェック
  if (v[1] = '{') And (v[28] = '}') then begin
    ex:=EDDPD.Create(v + 'は無効なプロパティです');
    raise ex;
  end;

  //変換変換っ
  try
    h:=2;
    t:=Pos('-',v);
    cnt:=Copy(v,h,t-h);
    rest:=Copy(v,t+1,length(v));

    if (t = 0) Or (length(cnt) <> 8) then begin
      ex:=EDDPD.Create(v + 'は無効なプロパティです');
      raise ex;
    end;
    g.D1:=StrToInt('$' + cnt);


    h:=1;
    t:=Pos('-',rest);
    cnt:=Copy(rest,h,t-h);
    rest:=Copy(rest,t+1,length(v));

    if (t = 0) Or (length(cnt) <> 4) then begin
      ex:=EDDPD.Create(v + 'は無効なプロパティです');
      raise ex;
    end;
    g.D2:=StrToInt('$' + cnt);


    h:=1;
    t:=Pos('-',rest);
    cnt:=Copy(rest,h,t-h);
    rest:=Copy(rest,t+1,length(v));

    if (t = 0) Or (length(cnt) <> 4) then begin
      ex:=EDDPD.Create(v + 'は無効なプロパティです');
      raise ex;
    end;
    g.D3:=StrToInt('$' + cnt);


    h:=1;
    t:=Pos('-',rest);
    cnt:=Copy(rest,h,t-h);
    rest:=Copy(rest,t+1,length(v));

    if (t = 0) Or (length(cnt) <> 4) then begin
      ex:=EDDPD.Create(v + 'は無効なプロパティです');
      raise ex;
    end;
    s:=cnt;

    cnt:=Copy(rest,1,length(rest)-1);
    if length(cnt) <> 12 then begin
      ex:=EDDPD.Create(v + 'は無効なプロパティです');
      raise ex;
    end;
    s:=s + cnt;


    For i:=0 to 7 do begin
      g.D4[i]:=StrToInt('$' + Copy(s,i*2,2));
    end;

  except
    ex:=EDDPD.Create(cnt + 'は無効なプロパティです');
    raise ex;
  end;

  FAppGuid:=g;

end;

function TDDPD.GetAppGuidStr:String;
var
  s:String;
  i:Integer;
begin

  result:=Format('{%.8x-%.4x-%.4x-',[FAppGuid.D1,FAppGuid.D2,FAppGuid.D3]);

  For i:=0 to 7 do begin
    s:=s + Format('%.2x',[FAppGuid.D4[i]]);
    if i = 1 then
      s:=s + '-';
  end;
  s:=s+'}';

  result:=result + s;
end;



function TDDPD.Execute:Boolean;
var
  d:TDDPDForm;
begin
  d:=TDDPDForm.Create(Nil);

  d.Connector:=Self;
  result:=d.ShowModal = mrOK;

  d.Free;
end;


(******************************************************************************
  Dialog
******************************************************************************)
procedure TDDPDForm.FormShow(Sender: TObject);
begin

  SessionList.Items.Clear;

  PlayerList.Items.Clear;

  ServiceProviderBox.Items.Clear;
  ServiceProviderBox.Items.Add('(接続方法を選んでください)');

  ServiceProviderBox.Items.AddStrings(Connector.FServiceProviders);
  ServiceProviderBox.ItemIndex:=0;

  GroupBox1.Enabled:=False;

  PlayerNameEdit.Text:='';

  NewSessionBtn.Enabled:=False;
end;


//セッションリストをクリックすると、参加しているプレイヤのリストを得る
procedure TDDPDForm.SessionListClick(Sender: TObject);
begin
  try
    if SessionList.ItemIndex >= 0 then begin
      Connector.InspectSession(SessionList.ItemIndex);
      Connector.Players.AssignToStrings(PlayerList.Items);
    end;
  except
    ModalResult:=mrAbort;
    Exit;
  end;
  JoinSessionBtn.Enabled:=SessionList.ItemIndex <> 1;
end;

procedure TDDPDForm.ServiceProviderBoxChange(Sender: TObject);
begin
  if PlayerNameEdit.Text = '' then begin
    MessageDlg('名前を入れてください',mtError,[mbOK],0);
    exit;
  end;

  try
    if ServiceProviderBox.ItemIndex < 1 then
      exit;

    //ちょっと時間かかるかもね
    AnimeThread:=TDDPDAnimationThread.Create(Self);

    if Connector.Connect(ServiceProviderBox.ItemIndex-1) <> DP_OK then begin
      modalResult:=mrAbort;
      exit;
    end;

    AnimeThread.Terminate;

    SessionList.Items.AddStrings(Connector.Sessions);
    GroupBox1.Enabled:=True;

    if ServiceProviderBox.ItemIndex <> -1 then begin
      NewSessionBtn.Enabled:=True;
    end;
  except
    //ModalResult:=mrAbort;
    AnimeThread.Terminate;

    SessionList.Items.Clear;
    GroupBox1.Enabled:=False;
    NewSessionBtn.Enabled:=False;
  end;
end;

procedure TDDPDForm.PlayerNameEditChange(Sender: TObject);
begin
  //OKBtn.Enabled:=PlayerNameEdit.Text <> '';
end;

procedure TDDPDForm.NewSessionBtnClick(Sender: TObject);
begin
  try
    Connector.CreateSession(PlayerNameEdit.Text, PlayerNameEdit.Text, PlayerNameEdit.Text);
  except
    ModalResult:=mrAbort;
    exit;
  end;

  ModalResult:=mrOK;
end;

procedure TDDPDForm.JoinSessionBtnClick(Sender: TObject);
begin
  //既存のセッションに参加
  if SessionList.ItemIndex >= 0 then begin
    try
      Connector.JoinSession(SessionList.ItemIndex, PlayerNameEdit.Text, PlayerNameEdit.Text);
    except
      modalResult:=mrAbort;
      exit;
    end;
  end else
    exit;

  ModalResult:=mrOK;
end;

procedure TDDPDForm.PaintBox1Paint(Sender: TObject);
begin
  PaintBox1.Canvas.CopyRect(Rect(0,0,32,32), Image1.Picture.Bitmap.Canvas, Rect(FFrame*32,0,(FFrame+1)*32,32));
end;



(******************************************************************************
  アニメスレッド
******************************************************************************)

constructor TDDPDAnimationThread.Create(Owner:TDDPDForm);
begin
  inherited Create(False);

  FOwner:=Owner;
  FreeOnTerminate:=True;
  FOwner.FFrame:=0;
end;

procedure TDDPDAnimationThread.Execute;
begin
  while not Terminated do begin

    Inc(FOwner.FFrame);
    if FOwner.FFrame >= 23 then
      FOwner.FFrame:=0;

    FOwner.PaintBox1Paint(FOwner.PaintBox1);

    Sleep(80);
  end;
end;

destructor TDDPDAnimationThread.Destroy;
begin
  FOwner.FFrame:=0;
  FOwner.PaintBox1Paint(FOwner.PaintBox1);
end;


initialization
CoInitialize(Nil);

finalization
CoUninitialize;


end.
