bottleclient/BottleSstp.pas

   1 unit BottleSstp;
   2
   3 interface
   4
   5 uses Classes, Contnrs, SyncObjs, Windows, Logs, SysUtils, Controls, Forms,
   6   Messages, BottleDef, SakuraSeekerInstance;
   7
   8 type
   9   TBottleSstpResult = (
  10     srOk,
  11     srNoContent,
  12     srBreak,
  13     srBadRequest,
  14     srRequestTimeout,
  15     srConflict,
  16     srRefuse,
  17     srNotImplemented,
  18     srServiceUnavailable,
  19     srNotLocalIP,
  20     srInBlackList,
  21     srUnknownError
  22   );
  23
  24   TBottleSstp = class(TThread)
  25   private
  26     FTargetHwnd: HWND;
  27     FProcessBottle: TLogItem;
  28     FDirectSstpResult: String;
  29     FSentLog: TStringList;
  30     FRecvLog: TStringList;
  31     FCueLock: TCriticalSection;
  32     FCue: TObjectList; // \83X\83\8c\83b\83h\83Z\81[\83t\82É\82È\82é\82æ\82¤\82É\92\8d\88Ó
  33     FWindowHandle: HWND;
  34   public
  35     constructor Create(CreateSuspended: boolean);
  36     destructor Destroy; override;
  37     procedure Execute; override;
  38     function ConnectSstp(Source: TStrings): TBottleSstpResult;
  39     procedure WndProc(var Msg: TMessage);
  40     procedure Push(Bottle: TLogItem);
  41     procedure Unshift(Bottle: TLogItem);
  42     function ExtractCode(const CodeStr: String): integer;
  43     function CodeToStatus(const Code: integer): TBottleSstpResult;
  44     procedure DetectTargetHWND;
  45   end;
  46
  47 implementation
  48
  49 const
  50   //\82±\82Ì\83G\83\89\81[\82Í\81ASSTP\83T\81[\83o\82ª\83X\83e\81[\83^\83X\82ð\95Ô\82³\82¸\82É\90Ø\92f\82µ\82½\82Æ\82«\82È\82Ç\82É\95Ô\82é
  51   UnknownError = -1000;
  52
  53 { TBottleSstpp }
  54
  55 // \82±\82ê\82Í\83X\83\8c\83b\83h\93à\82Å\91\96\82é\8aÖ\90\94
  56 function TBottleSstp.CodeToStatus(const Code: integer): TBottleSstpResult;
  57 begin
  58   case Code of
  59     200: Result := srOk;
  60     204: Result := srNoContent;
  61     210: Result := srBreak;
  62     400: Result := srBadRequest;
  63     408: Result := srRequestTimeout;
  64     409: Result := srConflict;
  65     420: Result := srRefuse;
  66     501: Result := srNotImplemented;
  67     503: Result := srServiceUnavailable;
  68     504: Result := srNotLocalIP;
  69     541: Result := srInBlackList;
  70   else
  71     Result := srUnknownError;
  72   end;
  73 end;
  74
  75 function TBottleSstp.ConnectSstp(Source: TStrings): TBottleSstpResult;
  76 var Mes: TCopyDataStruct;
  77     MesStr: String;
  78     Dummy: DWORD; //SendMessageTimeout\97p
  79     StatusCode: integer;
  80 begin
  81   Result := srUnknownError;
  82
  83   if FTargetHWnd <> 0 then begin
  84     MesStr := Source.Text;
  85     Mes.dwData := 9801;
  86     Mes.cbData := Length(MesStr);
  87     Mes.lpData := PChar(MesStr);
  88     FDirectSstpResult := '';
  89     FSentLog.Text := MesStr;
  90     SendMessageTimeout(FTargetHWnd, WM_COPYDATA, FWindowHandle, LPARAM(@Mes),
  91                        SMTO_ABORTIFHUNG or SMTO_NORMAL, 1000, Dummy);
  92     FRecvLog.Text := FDirectSstpResult;
  93     if FRecvLog.Count > 0 then
  94       StatusCode := ExtractCode(FRecvLog[0])
  95     else
  96       StatusCode := UnknownError;
  97     Result := CodeToStatus(StatusCode);
  98   end;
  99 end;
 100
 101 constructor TBottleSstp.Create(CreateSuspended: boolean);
 102 begin
 103   inherited;
 104   FCueLock := TCriticalSection.Create;
 105   FCue := TObjectList.Create(true);
 106   FWindowHandle := AllocateHWnd(WndProc);
 107 end;
 108
 109 destructor TBottleSstp.Destroy;
 110 begin
 111   FCue.Free;
 112   FCueLock.Free;
 113   DeallocateHWnd(FWindowHandle);
 114   inherited;
 115 end;
 116
 117 procedure TBottleSstp.DetectTargetHWND;
 118 begin
 119   FTargetHWnd := SakuraSeeker.ProcessByName[FProcessBottle.Ghost].HWnd;
 120 end;
 121
 122 procedure TBottleSstp.Execute;
 123 var Source: TStringList;
 124     Opt: String;
 125     Res: TBottleSstpResult;
 126 begin
 127   inherited;
 128   while not Terminated do begin
 129     sleep(2000);
 130     FCueLock.Enter;
 131     try
 132       if FCue.Count = 0 then Continue;
 133       FProcessBottle := FCue.Items[0] as TLogItem;
 134     finally
 135       FCueLock.Leave;
 136     end;
 137     // SakuraSeeker\82Í\83X\83\8c\83b\83h\83A\83\93\83Z\81[\83t\82È\82Ì\82Å
 138     // Synchronize\82Å\8cÄ\82Ñ\8fo\82·
 139     Synchronize(DetectTargetHWND);
 140
 141     // \82Å\82Í\91\97\90M\92v\82µ\82Ü\82µ\82å\82¤
 142     Source := TStringList.Create;
 143     try
 144       if Pref.NoTranslate then begin
 145        Opt := 'notranslate';
 146       end;
 147       if Pref.NoDescript then begin
 148         if Opt <> '' then Opt := Opt + ',';
 149         Opt := Opt + 'nodescript';
 150       end;
 151       Source.Add('SEND SSTP/1.4');
 152       Source.Add('Sender: ' + VersionString);
 153       Source.Add('Charset: Shift_JIS');
 154       if FProcessBottle.Ghost <> '' then
 155         Source.Add('IfGhost: ' + FProcessBottle.Ghost);
 156       Source.Add('Script: ' + FProcessBottle.Script);
 157       Source.Add('Option: ' + Opt);
 158       Source.Add('HWnd: ' + IntToStr(FWindowHandle));
 159       Source.Add(''); //\8bó\8ds\82ª\8fI\97¹\82ð\8e¦\82·
 160       Res := ConnectSstp(Source);
 161     finally
 162       Source.Free;
 163     end;
 164
 165     // \91\97\90M\8cã\82Ì\8f\88\97\9d
 166     if Res in [srOk] then begin
 167       FCueLock.Enter;
 168       try
 169         // Delete(0)\82¾\82ÆSSTP\90Ú\91±\92\86\82É\89½\82©\91\9d\82¦\82Ä\82é\89Â\94\\90«\82ª\82 \82é
 170         FCue.Remove(FProcessBottle);
 171       finally
 172         FCueLock.Leave;
 173       end;
 174     end;
 175
 176   //\81«\83\8b\81[\83v\8fI\97¹
 177   end;
 178 end;
 179
 180 function TBottleSstp.ExtractCode(const CodeStr: String): integer;
 181 var i, l: integer;
 182     s, p: String;
 183 begin
 184   if CodeStr = '' then begin
 185     Result := UnknownError;
 186     Exit;
 187   end;
 188   i := 1;
 189   l := length(CodeStr);
 190   while (CodeStr[i] <> ' ') and (i<=l) do begin
 191     p := p + CodeStr[i];
 192     Inc(i);
 193   end;
 194   Inc(i);
 195   while (CodeStr[i] in ['0'..'9']) and (i<=l) do begin
 196     s := s + CodeStr[i];
 197     Inc(i);
 198   end;
 199   try
 200     Result := StrToInt(s);
 201   except
 202     on EConvertError do Result := UnknownError;
 203   end;
 204 end;
 205
 206
 207 procedure TBottleSstp.Push(Bottle: TLogItem);
 208 var Item: TLogItem;
 209 begin
 210   Item := TLogItem.Create(Bottle);
 211   FCueLock.Enter;
 212   try
 213     FCue.Add(Item);
 214   finally
 215     FCueLock.Leave;
 216   end;
 217 end;
 218
 219 procedure TBottleSstp.Unshift(Bottle: TLogItem);
 220 var Item: TLogItem;
 221 begin
 222   Item := TLogItem.Create(Bottle);
 223   FCueLock.Enter;
 224   try
 225     FCue.Insert(0, Item);
 226   finally
 227     FCueLock.Leave;
 228   end;
 229 end;
 230
 231 procedure TBottleSstp.WndProc(var Msg: TMessage);
 232 var Dat: TWMCopyData;
 233 begin
 234   //\83X\83\8c\83b\83h\93à\8aÖ\90\94
 235   if Msg.Msg = WM_COPYDATA then begin
 236     Dat := TWMCopyData(Msg);
 237     FDirectSstpResult := PChar(Dat.CopyDataStruct^.lpData);
 238   end else begin
 239     Msg.Result := DefWindowProc(FWindowHandle, Msg.Msg, Msg.wParam, Msg.lParam);
 240   end;
 241 end;
 242
 243 end.