Вообще правильнее в процедуре CreateShortcuts пользовать
Win32API::GetSpecialFolderLocation с нужным параметром
(CSIDL_PROGRAMS в случае папки "Программы", или CSIDL_DESKTOP в случае
"Рабочего стола"). Как по IP адресу получить HostName (и обратно).
Хм... А ты увеpен, что пытался найти эту функцию?
Ты, навеpно, будешь очень удивлен (так уж повелось в этой эхе), но это
gethostbyaddr, а если в Winsock2, то можно еще WSAAddressToString
Скачиваешь с microsoft или с intel WinSock2 SDK и документацию (она отдельно),
там все есть.
Мне лень сейчас вспоминать и pазбиpаться, вот тебе кусочек, в котоpом этим
функции используются (не пpетендую на абсолютную истину, но с IP pаботает):
function TGenericNetTask.GetPeerOrigin( const ALogin : String ) : DWORD;
const AddressStrMaxLen = 256;
var len : DWORD;
ptr : PChar;
pHE : PHostEnt;
addr : TSockAddr;
buf : Array [0..AddressStrMaxLen-1] of Char;
begin
if FNet=nil then raise ESocketError.Error(-1,ClassName+'.GetPeerAds: Net is
not defined',WSAHOST_NOT_FOUND);
len := SizeOf(TSockAddr);
if getpeername(FSocket,addr,len)<>0 then
RaiseLastSocketError(-1,ClassName+'.GetPeerAds: getpeername()');
case addr.sin_family of
AF_INET: // TCP/IP
begin
pHE := gethostbyaddr( PChar(@addr.sin_addr), SizeOf(TInAddr),
AF_INET );
if pHE=nil then RaiseLastSocketError(-1,ClassName+'.GetPeerAds:
gethostbyaddr()');
FPeerNodeName := pHE^.h_name;
if FNet.NodeByName(FPeerNodeName)=nil then
begin
ptr := StrScan(pHE^.h_name,'.');
if ptr<>nil then FPeerNodeName :=
Copy(pHE^.h_name,1,ptr-pHE^.h_name);
end;
end;
else
len := AddressStrMaxLen;
if WSAAddressToStringA(sin,sinlen,nil,buf,len)<>0 then
RaiseLastSocketError(-1,ClassName+'.GetPeerAds: WSAAddressToStringA()');
ptr := StrRScan(buf,':');
if ptr<>nil then len := ptr-buf;
FPeerNodeName := Copy(buf,1,len);
end;
Result :=
FNet.EncodeAddress(ALogin,FPeerNodeName,'',[bLoginIdRequired,bNodeIdREquired,bR
aiseError]);
end; {TGenericNetTask.GetPeerOrigin} Есть ли у кого алгоритм переноса русского текста по слогам?
Вот, когда-то писал для QuarkXPress, который русских переносов не понимает. Hе
понимает сложные слова, но в 98% работает нормально.
{***********************************************************
* *
* Hypernation for QuarkQPress *
* written by Gorbunov A. A. *
* acdc@media-press.donetsk.ua *
* *
************************************************************}
unit Hyper;
interface
uses
Windows,Classes,SysUtils;
Function SetHyph(pc:PChar;MaxSize:Integer):PChar;
Function SetHyphString(s : String):String;
Function MayBeHyph(p:PChar;pos:Integer):Boolean;
implementation
Type
TSymbol=(st_Empty,st_NoDefined,st_Glas,st_Sogl,st_Spec);
TSymbAR=array [0..1000] of TSymbol;
PSymbAr=^TSymbAr;
Function isSogl(c:Char):Boolean;
begin
Result:=c in SoglChar;
end;
Function isGlas(c:Char):Boolean;
begin
Result:=c in GlasChar;
end;
Function isSpecSign(c:Char):Boolean;
begin
Result:=c in SpecSign;
end;
Function GetSymbType(c:Char):TSymbol;
begin
if isSogl(c) then begin Result:=st_Sogl;exit;end;
if isGlas(c) then begin Result:=st_Glas;exit;end;
if isSpecSign(c) then begin Result:=st_Spec;exit;end;
Result:=st_NoDefined;
end;
Function isSlogMore(c:pSymbAr;start,len:Integer):Boolean;
var i:Integer;
glFlag:Boolean;
begin
glFlag:=false;
for i:=Start to Len-1 do
begin
if c^[i]=st_NoDefined then begin Result:=false;exit;end;
if (c^[i]=st_Glas)and((c^[i+1]<>st_Nodefined)or(i<>Start))
then
begin
Result:=True;
exit;
end;
end;
Result:=false;
end;
{ ЁрёёЄрты ыър яхЁхэюёют }
Function SetHyph(pc:PChar;MaxSize:Integer):PChar;
var
HypBuff : Pointer;
h : PSymbAr;
i : Integer;
len : Integer;
Cur : Integer; { Tхъє•р яючшЎш т Ёрчєы№ЄшЁє¦•хь ьрёёштх }
cw : Integer; { =юьхЁ сєътv т ёыютх }
Lock: Integer; { ёўхЄўшъ сыюъшЁютюъ }
begin
Cur:=0;
len := StrLen(pc);
if (MaxSize=0)OR(Len=0) then
begin
Result:=nil;
Exit;
end;
GetMem(HypBuff,MaxSize);
GetMem(h,Len+1);
{ чряюыэхэшх ьрёёштр Єшяют ёшьтюыют }
for i:=0 to len-1 do h^[i]:=GetSymbType(pc[i]);
{ ёюсёЄтхээю ЁрёёЄрэютър яхЁхэюёют }
cw:=0;
Lock:=0;
for i:=0 to Len-1 do
begin
PChar(HypBuff)[cur]:=PChar(pc)[i];Inc(Cur);
if i>=Len-2 then Continue;
if h^[i]=st_NoDefined then begin cw:=0;Continue;end else Inc(cw);
if Lock<>0 then begin Dec(Lock);Continue;end;
if cw<=1 then Continue;
if not(isSlogMore(h,i+1,len)) then Continue;
if
(h^[i]=st_Sogl)and(h^[i-1]=st_Glas)and(h^[i+1]=st_Sogl)and(h^[i+2]<>st_Spec)
then begin PChar(HypBuff)[cur]:=HypSymb;Inc(Cur);Lock:=1;end;
if
(h^[i]=st_Glas)and(h^[i-1]=st_Sogl)and(h^[i+1]=st_Sogl)and(h^[i+2]=st_Glas)
then begin PChar(HypBuff)[cur]:=HypSymb;Inc(Cur);Lock:=1;end;
if
(h^[i]=st_Glas)and(h^[i-1]=st_Sogl)and(h^[i+1]=st_Glas)and(h^[i+2]=st_Sogl)
then begin PChar(HypBuff)[cur]:=HypSymb;Inc(Cur);Lock:=1;end;
if (h^[i]=st_Spec) then begin
PChar(HypBuff)[cur]:=HypSymb;Inc(Cur);Lock:=1; end;
Function Red_GlasMore(p:Pchar;pos:Integer):Boolean;
begin
While p[pos]<>#0 do
begin
if p[pos] in Spaces then begin Result:=False; Exit; end;
if isGlas(p[pos]) then begin Result:=True; Exit; end;
Inc(pos);
end;
Result:=False;
end;
Function Red_SlogMore(p:Pchar;pos:Integer):Boolean;
Var BeSogl,BeGlas:Boolean;
begin
BeSogl:=False;
BeGlas:=False;
While p[pos]<>#0 do
begin
if p[pos] in Spaces then Break;
if Not BeGlas then BeGlas:=isGlas(p[pos]);
if Not BeSogl then BeSogl:=isSogl(p[pos]);
Inc(pos);
end;
Result:=BeGlas and BeSogl;
end;
Function MayBeHyph(p:PChar;pos:Integer):Boolean;
var i:Integer;
len:Integer;
begin
i:=pos;
Len:=StrLen(p);
Result:=
(Len>3)
AND
(i>2)
AND
(i<Len-2)
AND
(not (p[i] in Spaces))
AND
(not (p[i+1] in Spaces))
AND
(not (p[i-1] in Spaces))
AND
(
(isSogl(p[i])and isGlas(p[i-1])and isSogl(p[i+1])and
Red_SlogMore(p,i+1))
OR
((isGlas(p[i]))and(isSogl(p[i-1]))and(isSogl(p[i+1]))and(isGlas(p[i+2])))
OR
((isGlas(p[i]))and(isSogl(p[i-1]))and(isGlas(p[i+1])) and
Red_SlogMore(p,i+1) )
OR
((isSpecSign(p[i])))
);
end;
Function SetHyphString(s : String):String;
Var Res:PChar;
begin
Res:=SetHyph(PChar(S),Length(S)*2)
Result:=Res;
FreeMem(Res,Length(S)*2);
end;
end. Как получить хэндлы всех пpоцессов, котоpые запущены на данный момент в системе?
Под Windows 95 это возможно с использованием вспомогательных
инфоpмационных функций (tool help functions).
Для получения списка пpоцессов надо делать следующее:
1. Cпеpва вызывается фукция
hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
// - получение снимка состояния системы
2. Process32First() - получене инфоpмации о пеpвом пpоцессе в списке
3. Далее в цикле Process32Next() - получение инфоpмации о следующем
пpоцессе в списке
procedure GetProcessList(List: TStrings);
var
I: Integer;
hSnapshoot: THandle;
pe32: TProcessEntry32;
begin
List.Clear;
hSnapshoot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if (hSnapshoot = -1) then
Exit;
pe32.dwSize := SizeOf(TProcessEntry32);
if (Process32First(hSnapshoot, pe32)) then
repeat
I := List.Add(Format('%x, %x: %s',
[pe32.th32ProcessID, pe32.th32ParentProcessID, pe32.szExeFile]));
List.Objects[I] := Pointer(pe32.th32ProcessID);
until not Process32Next(hSnapshoot, pe32);
CloseHandle (hSnapshoot);
end;
procedure GetModuleList(List: TStrings);
var
I: Integer;
hSnapshoot: THandle;
me32: TModuleEntry32;
begin
List.Clear;
hSnapshoot := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, 0);
if (hSnapshoot = -1) then
Exit;
me32.dwSize := SizeOf(TModuleEntry32);
if (Module32First(hSnapshoot, me32)) then
repeat
I := List.Add(me32.szModule);
List.Objects[I] := Pointer(me32.th32ModuleID);
until not Module32Next(hSnapshoot, me32);
CloseHandle (hSnapshoot);
end;
procedure GetParentProcessInfo(var ID: DWORD; var Path: String);
var
ProcessID: DWORD;
hSnapshoot: THandle;
pe32: TProcessEntry32;
begin
ProcessID := GetCurrentProcessID;
ID := -1;
Path := '';
pe32.dwSize := SizeOf(TProcessEntry32);
if (Process32First(hSnapshoot, pe32)) then
repeat
if pe32.th32ProcessID = ProcessID then
begin
ID := pe32.th32ParentProcessID;
Break;
end;
until not Process32Next(hSnapshoot, pe32);
if ID <> -1 then
begin
if (Process32First(hSnapshoot, pe32)) then
repeat
if pe32.th32ProcessID = ID then
begin
Path := pe32.szExeFile;
Break;
end;
until not Process32Next(hSnapshoot, pe32);
end;
CloseHandle (hSnapshoot);
end;
function GetProcessHandle(ProcessID: DWORD): THandle;
begin
Result := OpenProcess(PROCESS_ALL_ACCESS, True, ProcessID);
end;
Создатель этого HTML файла не претендует на авторство вопросов/ответов представленных в нём, не отвечает за их содержание и достоверность, а также за последствия использования программных кодов , полученных из этого HTML файла. Также не принимаются претензии относительно не размещённой информации об авторе каждого конкретного FAQ'а. Любые другие вопросы присылайте на
bad_guy@cracklab.ru (обращаться к Bad_guy'ю).
