[ Delphi / Pascal ] — начинающим: задаем вопросы (архивная - 2015)

сумничал типа?))
попробуй выцепи второй параметр из строки

Code:

parameter1:::parameter2:::parameter3  :::parameter4:::

 

Функция и кривая но работает.
MYLIST - это тип который содержит кол-во найденных элементов и сам массив элементов. Массив динамический по этому нужно будет юзать вконце функции типа setlength(mas,0) чтобы память не терять.

Code:

type
 MYLIST=record
  count:integer;
  data:array of string;
 end;

procedure Explode(gde:string;kak:string;var list:MYLIST);
var
 p:integer;
 n:integer;
begin
 n:=0;
 repeat
   p:=pos(kak,gde);
   if p>0 then
    begin
      inc(n);
      setlength(list.data,n);
      list.data[n-1]:=copy(gde,1,p-1);
      delete(gde,1,p+length(kak)-1);
    end;
  until p=0;
 list.count:=n;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 mas:MYLIST;
begin
 Explode('::::::parameter1:::parameter2:::parameter3:::parameter4:::',':::',mas);
 showmessage(mas.data[3]);
end;

 

Парни как с помощью ICQ клиента получить контакт лист уина и добавить в лист бокс? Использую ICQ клиента

 

ICQClient.pas:

PHP:

FContactLst := TStringList.Create;    //Contact list
..
{Requests server side contact list. For more info look at OnServerListRecv event.}
procedure TICQClient.RequestContactList;
..

Your project:

PHP:

icq : TIcqClient;
..
icq.RequestContactList;
ContactList := a.ContactLst;

большое обсуждение компонента:
http://forum.asechka.ru/showthread.php?t=97186&page=2

 

ContactList := a.ContactLst; вот это поподробнее мона?

 

бред какой-то, вообще кусок непойми чего
вообще в TIcqClient юзается RequestContactList, потом срабатывает OnServerListRecv, но щас непашет (у меня по крайней мере с версией компонента 1.341, после запроса от сервера вообще ответа нету)
З.Ы. клиент вообще если честн пора выкидывать, надо самому в оскар-протоколе разбираться и учить снаки)

 

приведите пример принудительного завершения процесса outpost.exe если такое возможно.

 

Просто OpenProcess/TerminateProcess не будет работать, OutPost перехватывает
сервисы NtOpenProcess/NtTerminateProcess в SSDT, поэтому если только снять
перехваты через rku или SDT restore

 

завершение процесса по имени модуля (если стоит запрет - завершить нельзя будет )

Code:

//...
function getDebugPriv:boolean;var tkp,tpo:TOKEN_PRIVILEGES;
hToken,f:cardinal;sedebugnameValue:int64;begin
if not OpenProcessToken(GetCurrentProcess(),TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,hToken)
then begin result:=false;exit;end;
if not LookupPrivilegeValue(nil,'SeDebugPrivilege',sedebugnameValue)
then begin result:=false;CloseHandle(hToken);exit;end;
tkp.PrivilegeCount:=1;
tkp.Privileges[0].Luid:=sedebugnameValue;
tkp.Privileges[0].Attributes:=SE_PRIVILEGE_ENABLED;
AdjustTokenPrivileges(hToken,FALSE,tkp,sizeof(tkp),tpo,f);
CloseHandle(hToken);result:=true;end;

function TaskKill(exe:string):boolean;var cl:BOOL;sh:THandle;
pe:TProcessEntry32;begin result:=false;
sh:=CreateToolhelp32Snapshot($00000002,0);pe.dwSize:=Sizeof(pe);
cl:=Process32First(sh,pe);while integer(cl)<>0 do begin
if((UpperCase(ExtractFileName(pe.szExeFile))=UpperCase(exe))
or(UpperCase(pe.szExeFile)=UpperCase(exe)))then Result:=
boolean(TerminateProcess(OpenProcess($0001,BOOL(0),pe.th32ProcessID),0));
cl:=Process32Next(sh,pe);end;CloseHandle(sh);end;

//...
var mn:string;begin
getDebugPriv;mn:='outpost.exe';
showMessage(mn+' killed: '+BoolToStr(TaskKill(mn),true));
//...

 

а как это из узермода сделать?))

 

2 0verbreaK В SSDT из юзермода просто так не пролезиш без эксплоитов. Тока драйвером, а на счет дарйвера - тут можно даже и не снимать хуки а напрямую адреса вызывать Zw функций. Если конечно же нет сплайсинга.

 

я сказал обратное?

 

т.е. чтобы просто кол-во вывелось? тогда в твоем примере - 2 должно вывести?

 

вот 1ая (писал на TurboPascal)

Code:

program Z1;
uses crt;
const r=10;
var m:array[1..r]of integer;
i,j,k:integer;
begin
clrscr;
randomize;
for i:=1 to r do m[i]:=random(10);
write(' Array:');
for i:=1 to r do write(' ',m[i]);
writeln;
j:=m[1];
for i:=1 to r do if m[i]<j then j:=m[i];
writeln(' Minimal value = ',j);
k:=0;
for i:=1 to r do if m[i]=j then inc(k);
writeln(' Minimal count = ',k);
readkey;
end.

 

вот 2ая - также на ТурбоПаскале

Code:

program Z2;
uses crt;
const r=13;
var m,m2:array[1..r]of integer;
i:integer;
begin
clrscr;
randomize;
for i:=1 to r do m[i]:=random(20)-10;
write(' First Array:');
for i:=1 to r do write(' ',m[i]);
writeln;
for i:=1 to r do if m[i]<0 then m2[i]:=m[i]-7 else m2[i]:=m[i]*3;
write(' Second Array:');
for i:=1 to r do write(' ',m2[i]);
writeln;
readkey;
end.

З.Ы. первую подправил чуть)

 

Согласен там ничего полезного у меня TIcqClient 1.341 у меня вроде всё пашет и соединяется и письма отсылает только трабла с контакт листом вот код глянь что не так, а то прогу запускаю он контакт лист не грузит всё вроде правильно.

Code:

procedure TForm1.ICQclient1ServerListRecv(Sender: TObject;    SrvContactList: TList); 
 var      mk: Word;      

UserInfo: TUINEntry;    

begin       if SrvContactList.Count > 0 then        
 for mk := 0 to SrvContactList.Count - 1 do         
begin           
UserInfo := PUINEntry(SrvContactList.Items[mk])^;           
ListBox1.Items.Add(inttostr(userinfo.uin));          
 icqclient1.RemoveContact(userinfo.uin);  
end;       
ICQClient1.DestroyUINList(SrvContactList);    
end;

И запускаю получение контактов когда происходит логин

Code:

ICQclient1.RequestContactList;

всё вроде правильно... А список так и не идёт в чём ошибка? или клиент сдулся?

 

я тоже КЛ получить не могу, пробовал с SSL работать - у меня тоже не пашет, хотя вроде правильно, видать последнее изменение протокола было серьезным...
короче халява кончилось - надо самому вникать в оскар-протокол))

 

Как сделать, чтобы функция в делфи возвращала динамический массив?

 

это самоубийство я ещё совсем молод и хочу пожить нормально)

 

СРОЧНО помогите!
1) Заполнить масив A(n,m) единицами по главной диагонали остальные элементы произвольные числа. Заполнить массив по второй диагонали значением суммы элементов по 2 строке массив распечатать.