interface
-uses Classes, Contnrs, SyncObjs, Windows, Logs;
+uses Classes, Contnrs, SyncObjs, Windows, Logs, SysUtils, Controls, Forms,
+ Messages, BottleDef, SakuraSeekerInstance;
type
+ TBottleSstpResult = (
+ srOk,
+ srNoContent,
+ srBreak,
+ srBadRequest,
+ srRequestTimeout,
+ srConflict,
+ srRefuse,
+ srNotImplemented,
+ srServiceUnavailable,
+ srNotLocalIP,
+ srInBlackList,
+ srUnknownError
+ );
TBottleSstp = class(TThread)
private
+ FTargetHwnd: HWND;
+ FProcessBottle: TLogItem;
+ FDirectSstpResult: String;
+ FSentLog: TStringList;
+ FRecvLog: TStringList;
FCueLock: TCriticalSection;
FCue: TObjectList; // \83X\83\8c\83b\83h\83Z\81[\83t\82É\82È\82é\82æ\82¤\82É\92\8d\88Ó
+ FWindowHandle: HWND;
public
constructor Create(CreateSuspended: boolean);
destructor Destroy; override;
+ procedure Execute; override;
+ function ConnectSstp(Source: TStrings): TBottleSstpResult;
+ procedure WndProc(var Msg: TMessage);
procedure Push(Bottle: TLogItem);
procedure Unshift(Bottle: TLogItem);
- procedure Execute; override;
+ function ExtractCode(const CodeStr: String): integer;
+ function CodeToStatus(const Code: integer): TBottleSstpResult;
+ procedure DetectTargetHWND;
end;
implementation
-{ TBottleSstp }
+const
+ //\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é
+ UnknownError = -1000;
+
+{ TBottleSstpp }
+
+// \82±\82ê\82Í\83X\83\8c\83b\83h\93à\82Å\91\96\82é\8aÖ\90\94
+function TBottleSstp.CodeToStatus(const Code: integer): TBottleSstpResult;
+begin
+ case Code of
+ 200: Result := srOk;
+ 204: Result := srNoContent;
+ 210: Result := srBreak;
+ 400: Result := srBadRequest;
+ 408: Result := srRequestTimeout;
+ 409: Result := srConflict;
+ 420: Result := srRefuse;
+ 501: Result := srNotImplemented;
+ 503: Result := srServiceUnavailable;
+ 504: Result := srNotLocalIP;
+ 541: Result := srInBlackList;
+ else
+ Result := srUnknownError;
+ end;
+end;
+
+function TBottleSstp.ConnectSstp(Source: TStrings): TBottleSstpResult;
+var Mes: TCopyDataStruct;
+ MesStr: String;
+ Dummy: DWORD; //SendMessageTimeout\97p
+ StatusCode: integer;
+begin
+ Result := srUnknownError;
+
+ if FTargetHWnd <> 0 then begin
+ MesStr := Source.Text;
+ Mes.dwData := 9801;
+ Mes.cbData := Length(MesStr);
+ Mes.lpData := PChar(MesStr);
+ FDirectSstpResult := '';
+ FSentLog.Text := MesStr;
+ SendMessageTimeout(FTargetHWnd, WM_COPYDATA, FWindowHandle, LPARAM(@Mes),
+ SMTO_ABORTIFHUNG or SMTO_NORMAL, 1000, Dummy);
+ FRecvLog.Text := FDirectSstpResult;
+ if FRecvLog.Count > 0 then
+ StatusCode := ExtractCode(FRecvLog[0])
+ else
+ StatusCode := UnknownError;
+ Result := CodeToStatus(StatusCode);
+ end;
+end;
constructor TBottleSstp.Create(CreateSuspended: boolean);
begin
inherited;
FCueLock := TCriticalSection.Create;
FCue := TObjectList.Create(true);
+ FWindowHandle := AllocateHWnd(WndProc);
end;
destructor TBottleSstp.Destroy;
begin
FCue.Free;
FCueLock.Free;
+ DeallocateHWnd(FWindowHandle);
inherited;
end;
+procedure TBottleSstp.DetectTargetHWND;
+begin
+ FTargetHWnd := SakuraSeeker.ProcessByName[FProcessBottle.Ghost].HWnd;
+end;
+
procedure TBottleSstp.Execute;
+var Source: TStringList;
+ Opt: String;
+ Res: TBottleSstpResult;
begin
inherited;
while not Terminated do begin
sleep(2000);
+ FCueLock.Enter;
+ try
+ if FCue.Count = 0 then Continue;
+ FProcessBottle := FCue.Items[0] as TLogItem;
+ finally
+ FCueLock.Leave;
+ end;
+ // SakuraSeeker\82Í\83X\83\8c\83b\83h\83A\83\93\83Z\81[\83t\82È\82Ì\82Å
+ // Synchronize\82Å\8cÄ\82Ñ\8fo\82·
+ Synchronize(DetectTargetHWND);
+ // \82Å\82Í\91\97\90M\92v\82µ\82Ü\82µ\82å\82¤
+ Source := TStringList.Create;
+ try
+ if Pref.NoTranslate then begin
+ Opt := 'notranslate';
+ end;
+ if Pref.NoDescript then begin
+ if Opt <> '' then Opt := Opt + ',';
+ Opt := Opt + 'nodescript';
+ end;
+ Source.Add('SEND SSTP/1.4');
+ Source.Add('Sender: ' + VersionString);
+ Source.Add('Charset: Shift_JIS');
+ if FProcessBottle.Ghost <> '' then
+ Source.Add('IfGhost: ' + FProcessBottle.Ghost);
+ Source.Add('Script: ' + FProcessBottle.Script);
+ Source.Add('Option: ' + Opt);
+ Source.Add('HWnd: ' + IntToStr(FWindowHandle));
+ Source.Add(''); //\8bó\8ds\82ª\8fI\97¹\82ð\8e¦\82·
+ Res := ConnectSstp(Source);
+ finally
+ Source.Free;
+ end;
+
+ // \91\97\90M\8cã\82Ì\8f\88\97\9d
+ if Res in [srOk] then begin
+ FCueLock.Enter;
+ try
+ // Delete(0)\82¾\82ÆSSTP\90Ú\91±\92\86\82É\89½\82©\91\9d\82¦\82Ä\82é\89Â\94\\90«\82ª\82 \82é
+ FCue.Remove(FProcessBottle);
+ finally
+ FCueLock.Leave;
+ end;
+ end;
+
+ //\81«\83\8b\81[\83v\8fI\97¹
end;
end;
+function TBottleSstp.ExtractCode(const CodeStr: String): integer;
+var i, l: integer;
+ s, p: String;
+begin
+ if CodeStr = '' then begin
+ Result := UnknownError;
+ Exit;
+ end;
+ i := 1;
+ l := length(CodeStr);
+ while (CodeStr[i] <> ' ') and (i<=l) do begin
+ p := p + CodeStr[i];
+ Inc(i);
+ end;
+ Inc(i);
+ while (CodeStr[i] in ['0'..'9']) and (i<=l) do begin
+ s := s + CodeStr[i];
+ Inc(i);
+ end;
+ try
+ Result := StrToInt(s);
+ except
+ on EConvertError do Result := UnknownError;
+ end;
+end;
+
+
procedure TBottleSstp.Push(Bottle: TLogItem);
var Item: TLogItem;
begin
end;
end;
+procedure TBottleSstp.WndProc(var Msg: TMessage);
+var Dat: TWMCopyData;
+begin
+ //\83X\83\8c\83b\83h\93à\8aÖ\90\94
+ if Msg.Msg = WM_COPYDATA then begin
+ Dat := TWMCopyData(Msg);
+ FDirectSstpResult := PChar(Dat.CopyDataStruct^.lpData);
+ end else begin
+ Msg.Result := DefWindowProc(FWindowHandle, Msg.Msg, Msg.wParam, Msg.lParam);
+ end;
+end;
+
end.
OSDN Git Service
