-(*********************************************************
-
- SakuraSeeker Component - Listups Existing Sakura.exe
- (C)2001-2002 naruto/CANO-Lab All Rights Reserved.
-
- \95K\82¸\8eg\97p\8fð\8c\8f\82É\82µ\82½\82ª\82Á\82Ä\82¨\8eg\82¢\82\82¾\82³\82¢\81B
- \81\9a\82±\82Ì\83R\83\93\83|\81[\83l\83\93\83g\82ð\8eg\97p\82µ\82½\83v\83\8d\83O\83\89\83\80\82ð\8cö\8aJ\82·\82é\8fê\8d\87\82Í\81A
-\81@\81@\8dì\8eÒ\82É\88ê\95ñ\82·\82é\95K\97v\82ª\82 \82è\82Ü\82·\81B\8fÚ\82µ\82\82Í\90à\96¾\8f\91\82ð\81B
-
-**********************************************************)
+{********************************************************}
+{ SakuraSeeker Component - Listups Existing SSTP Servers }
+{ }
+{ Copyright (c) 2001-2003 naruto/CANO-Lab }
+{********************************************************}
unit SakuraSeeker;
TSakuraSeeker = class;
+ TSakuraSeekerGetMutexNameEvent = procedure (Sender: TObject;
+ var Name: String) of object;
+
TSakuraProcess = class(TObject)
private
FHash: TStringList;
function GetDataAt(Index: integer): String;
function GetCount: integer;
function GetKeyAt(Index: integer): String;
+ protected
+ procedure AppendData(const Key, Value: String);
public
constructor Create(AOwner: TSakuraSeeker);
destructor Destroy; override;
- procedure AppendData(const Key, Value: String);
property ProcessID: String read FProcessID write SetProcessID;
property FMOName: String read FFMOName write SetFMOName;
property HWnd: THandle read GetHWnd;
FSourceResult: String; //\8d¡\89ñ\82Ì\8eæ\93¾\8c\8b\89Ê\81B\94ä\8ar\97p
FOnDetectResultChanged: TNotifyEvent;
FFileMappingTarget: TStrings;
+ FOnGetMutexName: TSakuraSeekerGetMutexNameEvent;
+ FMutexPool: TStringList;
function GetProcess(Index: integer): TSakuraProcess;
procedure SetAutoDetect(const Value: boolean);
function GetProcessByName(Name: String): TSakuraProcess;
procedure SetOnDetectResultChanged(const Value: TNotifyEvent);
procedure SetFileMappingTarget(const Value: TStrings);
function GetProcessBySetName(Name: String): TSakuraProcess;
+ procedure SetOnGetMutexName(
+ const Value: TSakuraSeekerGetMutexNameEvent);
protected
{ Protected \90é\8c¾ }
- //FSakuraAPI: integer;
procedure Loaded; override;
procedure ClearList;
procedure BeginDetectOne(const Target: String);
+ function GetMutexName(const Target: String): String;
+ function GetMutex(const Name: String): THandle;
public
{ Public \90é\8c¾ }
procedure BeginDetect;
property OnAfterDetection: TNotifyEvent read FOnAfterDetection write SetOnAfterDetection;
property OnDetectResultChanged: TNotifyEvent read FOnDetectResultChanged write SetOnDetectResultChanged;
property FileMappingTarget: TStrings read FFileMappingTarget write SetFileMappingTarget;
+ property OnGetMutexName: TSakuraSeekerGetMutexNameEvent read FOnGetMutexName write SetOnGetMutexName;
end;
procedure Register;
function TSakuraProcess.GetDataAt(Index: integer): String;
begin
- Result := FHash.ValueFromIndex[Index];
+ if Index >= 0 then
+ Result := Copy(FHash[Index], Length(FHash.Names[Index]) + 2, High(integer))
+ else
+ Result := '';
end;
function TSakuraProcess.GetHWnd: THandle;
end;
procedure TSakuraSeeker.BeginDetectOne(const Target: String);
-var MappingHandle: THandle;
- P: pointer;
+var MappingHandle, Mutex: THandle;
+ P, PSaved: pointer;
SourceStr, ID, Entry, Data: String;
Size: integer;
Strs: TStringList;
i, j: integer;
begin
//\83t\83@\83C\83\8b\83}\83b\83s\83\93\83O\83I\83u\83W\83F\83N\83g\82Ì\8eæ\93¾
- P := nil; Strs := nil;
- MappingHandle := OpenFileMapping(FILE_MAP_READ, false, PChar(Target));
+ PSaved := nil;
+ Strs := nil;
+ MappingHandle := 0;
+
+ Mutex := GetMutex(GetMutexName(Target));
+ if Mutex = 0 then
+ raise ESakuraSeekerError.Create('Mutex\83n\83\93\83h\83\8b\82ð\8eæ\93¾\82Å\82«\82Ü\82¹\82ñ\82Å\82µ\82½');
+ if WaitForSingleObject(Mutex, 3000) = WAIT_TIMEOUT then
+ raise ESakuraSeekerError.Create('Mutex\93¯\8aú\83^\83C\83\80\83A\83E\83g');
try
- if MappingHandle = 0 then begin
- SourceStr := '';
- end else begin
- P := MapViewOfFile(MappingHandle, FILE_MAP_READ, 0, 0, 0);
- if P <> nil then begin
- CopyMemory(@Size, P, SizeOf(integer));
- Inc(PChar(P), SizeOf(integer));
- SourceStr := PChar(P);
- if Length(SourceStr) > Size then
- raise ESakuraSeekerError.Create('FMO\82ð\8eæ\93¾\82Å\82«\82Ü\82¹\82ñ\82Å\82µ\82½');
+ MappingHandle := OpenFileMapping(FILE_MAP_READ, false, PChar(Target));
+ try
+ if MappingHandle = 0 then begin
+ SourceStr := '';
+ end else begin
+ PSaved := MapViewOfFile(MappingHandle, FILE_MAP_READ, 0, 0, 0);
+ P := PSaved;
+ if P <> nil then begin
+ CopyMemory(@Size, P, SizeOf(integer));
+ Inc(PChar(P), SizeOf(integer));
+ SourceStr := PChar(P);
+ if Length(SourceStr) > Size then
+ raise ESakuraSeekerError.Create('FMO\82ð\8eæ\93¾\82Å\82«\82Ü\82¹\82ñ\82Å\82µ\82½');
+ end;
end;
+ finally
+ //\83I\83u\83W\83F\83N\83g\82Ì\94j\8aü
+ if PSaved <> nil then UnmapViewOfFile(PSaved);
end;
finally
- //\83I\83u\83W\83F\83N\83g\82Ì\94j\8aü
- if P <> nil then UnmapViewOfFile(P);
if MappingHandle <> 0 then CloseHandle(MappingHandle);
+ ReleaseMutex(Mutex);
end;
//\83f\81[\83^\82ð\89ð\90Í
ID := Copy(Strs[i], 1, j-1);
Entry := Copy(Strs[i], j+1, Pos(#1, Strs[i])-j-1);
Data := Copy(Strs[i], Pos(#1, Strs[i])+1, High(integer));
- //ShowMessage(ID + '/' + Entry + '/' + Data);
Pro := GetProcessByID(ID);
if Pro = nil then begin
Pro := TSakuraProcess.Create(self);
FList := TObjectList.Create;
FFileMappingTarget := TStringList.Create;
FFileMappingTarget.Add('Sakura');
- //
- //FSakuraAPI := RegisterWindowMessage('Sakura');
+ FMutexPool := TStringList.Create;
end;
destructor TSakuraSeeker.Destroy;
+var i: integer;
begin
ClearList;
FList.Free;
FFileMappingTarget.Free;
+ for i := 0 to FMutexPool.Count-1 do
+ begin
+ CloseHandle(StrToInt(Copy(FMutexPool[i], Pos('=', FMutexPool[i])+1, High(integer))));
+ end;
+ FreeAndNil(FMutexPool);
end;
function TSakuraSeeker.GetCount: integer;
Result := FList.Count;
end;
-function TSakuraSeeker.GetProcess(Index: integer): TSakuraProcess;
+function TSakuraSeeker.GetMutex(const Name: String): THandle;
begin
- try
- Result := FList[Index] as TSakuraProcess;
- except
- raise ESakuraSeekerError.Create('\83\8a\83X\83g\82Ì\97L\8cø\94Í\88Í\82Ì\83C\83\93\83f\83b\83N\83X\82ª\8ew\92è\82³\82ê\82Ü\82µ\82½');
+ if FMutexPool.Values[Name] <> '' then
+ begin
+ Result := THandle(StrToInt(FMutexPool.Values[Name]));
+ end else
+ begin
+ Result := CreateMutex(nil, false, PChar(Name));
+ if Result <> 0 then
+ FMutexPool.Values[Name] := IntToStr(Result);
end;
end;
+function TSakuraSeeker.GetMutexName(const Target: String): String;
+begin
+ if Assigned(FOnGetMutexName) then
+ begin
+ Result := Target;
+ FOnGetMutexName(self, Result);
+ end else
+ Result := Target + 'FMO';
+end;
+
+function TSakuraSeeker.GetProcess(Index: integer): TSakuraProcess;
+begin
+ Result := FList[Index] as TSakuraProcess;
+end;
+
function TSakuraSeeker.GetProcessByID(ID: String): TSakuraProcess;
var i: integer;
begin
end;
function TSakuraSeeker.KillFMO(const TargetFMOName, TargetID: String): boolean;
-var MappingHandle: THandle;
+var MappingHandle, Mutex: THandle;
P: pointer;
SourceStr, ID: String;
Size: integer;
//\83t\83@\83C\83\8b\83}\83b\83s\83\93\83O\83I\83u\83W\83F\83N\83g\82Ì\8eæ\93¾
Result := false;
P := nil;
- MappingHandle := OpenFileMapping(FILE_MAP_WRITE, false, PChar(TargetFMOName));
- if MappingHandle = 0 then Exit;
+ Mutex := GetMutex(GetMutexName(TargetFMOName));
+ if Mutex = 0 then
+ raise ESakuraSeekerError.Create('Mutex\83n\83\93\83h\83\8b\82ð\8eæ\93¾\82Å\82«\82Ü\82¹\82ñ\82Å\82µ\82½');
+ if WaitForSingleObject(Mutex, 3000) = WAIT_TIMEOUT then
+ raise ESakuraSeekerError.Create('Mutex\93¯\8aú\83^\83C\83\80\83A\83E\83g');
try
- SourceStr := '';
- P := MapViewOfFile(MappingHandle, FILE_MAP_WRITE, 0, 0, 0);
- if P <> nil then begin
- CopyMemory(@Size, P, SizeOf(integer));
- Inc(PChar(P), SizeOf(integer));
- SourceStr := PChar(P);
- if Length(SourceStr) > Size then
- raise ESakuraSeekerError.Create('FMO\82ð\8eæ\93¾\82Å\82«\82Ü\82¹\82ñ\82Å\82µ\82½');
- end;
-
- //\83f\81[\83^\82ð\89ð\90Í
- Strs := TStringList.Create;
+ MappingHandle := OpenFileMapping(FILE_MAP_WRITE, false, PChar(TargetFMOName));
+ if MappingHandle = 0 then Exit;
try
- Strs.Text := SourceStr;
- for i := Strs.Count-1 downto 0 do begin
- j := Pos('.', Strs[i]);
- ID := Copy(Strs[i], 1, j-1);
- if ID = TargetID then begin
- Strs.Delete(i); // \97v\82ç\82È\82¢\83G\83\93\83g\83\8a\82ð\8dí\8f\9c
- Result := true;
+ SourceStr := '';
+ P := MapViewOfFile(MappingHandle, FILE_MAP_WRITE, 0, 0, 0);
+ if P <> nil then begin
+ CopyMemory(@Size, P, SizeOf(integer));
+ Inc(PChar(P), SizeOf(integer));
+ SourceStr := PChar(P);
+ if Length(SourceStr) > Size then
+ raise ESakuraSeekerError.Create('FMO\82ð\8eæ\93¾\82Å\82«\82Ü\82¹\82ñ\82Å\82µ\82½');
+ end;
+
+ //\83f\81[\83^\82ð\89ð\90Í
+ Strs := TStringList.Create;
+ try
+ Strs.Text := SourceStr;
+ for i := Strs.Count-1 downto 0 do begin
+ j := Pos('.', Strs[i]);
+ ID := Copy(Strs[i], 1, j-1);
+ if ID = TargetID then begin
+ Strs.Delete(i); // \97v\82ç\82È\82¢\83G\83\93\83g\83\8a\82ð\8dí\8f\9c
+ Result := true;
+ end;
end;
+ SourceStr := Strs.Text;
+ finally
+ Strs.Free;
end;
- SourceStr := Strs.Text;
- finally
- Strs.Free;
- end;
- if Result then begin
- CopyMemory(P, PChar(SourceStr), Length(SourceStr)+1);
- Dec(PChar(P), SizeOf(integer));
+ if Result then begin
+ CopyMemory(P, PChar(SourceStr), Length(SourceStr)+1);
+ Dec(PChar(P), SizeOf(integer));
+ end;
+ finally
+ //\83I\83u\83W\83F\83N\83g\82Ì\94j\8aü
+ if P <> nil then UnmapViewOfFile(P);
+ CloseHandle(MappingHandle);
end;
finally
- //\83I\83u\83W\83F\83N\83g\82Ì\94j\8aü
- if P <> nil then UnmapViewOfFile(P);
- CloseHandle(MappingHandle);
+ ReleaseMutex(Mutex);
end;
end;
FOnDetectResultChanged := Value;
end;
+procedure TSakuraSeeker.SetOnGetMutexName(
+ const Value: TSakuraSeekerGetMutexNameEvent);
+begin
+ FOnGetMutexName := Value;
+end;
+
end.
\ No newline at end of file
OSDN Git Service
