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

Discussion in 'С/С++, C#, Rust, Swift, Go, Java, Perl, Ruby' started by banned, 6 May 2007.

Thread Status:
Not open for further replies.
Page 74 of 489
  1. Pir4tt

    Pir4tt Elder - Старейшина

    Joined:
    3 Jan 2008
    Messages:
    73
    Likes Received:
    36
    Reputations:
    5
    В юзес добавь систем:
    Code:
    uses
  SysUtils, [b]System[/b];
    Перед этим:
    Code:
    x1:=pos('<display-name>',a);
    Поставь:
    Code:
    a:=Utf8ToAnsi(a);
    это решит проблему с кодировкой
     
    #1461 Pir4tt, 1 May 2008
    1 person likes this.
  2. -Hormold-

    -Hormold- Кто, если не ты?

    Joined:
    29 Sep 2007
    Messages:
    418
    Likes Received:
    290
    Reputations:
    44
    Code:
    Function Rss(Url:String):String;
Function Exists(S:String):Boolean;
begin
 if (S='description') or (s='title') or (s='link') then result:=true else result:=false;
end;
var
 i,k:integer;
 s:String;
 IdHTTP:TIdHTTP;
 XMLDocument:TXMLDocument;
Begin
 IdHTTP:=TIdHTTP.Create(nil);
 XMLDocument:=TXMLDocument.Create(Application);
 try
  XMLDocument.XML.Text:= IdHTTP.Get(Url);
  XMLDocument.Active:=true;

  i:=0;
  while i<>9 do begin
   if i>XMLDocument.DocumentElement.ChildNodes[0].ChildNodes.count then break;
   for k:=0 to XMLDocument.DocumentElement.ChildNodes[0].ChildNodes[i].ChildNodes.Count-1 do begin
     if (XMLDocument.DocumentElement.ChildNodes[0].ChildNodes[i].ChildNodes[k].LocalName='title') and (s<>'') then s:=s+#13#10+#13#10;
     if Exists(XMLDocument.DocumentElement.ChildNodes[0].ChildNodes[i].ChildNodes[k].LocalName) then
       s:=s+XMLDocument.DocumentElement.ChildNodes[0].ChildNodes[i].ChildNodes[k].text+#13#10;;
   end;
   inc(i);
  end;
  result:=s;
 finally
  XMLDocument.Free;
  IdHTTP.Free;
 end;
  end;
    Работает:
    Code:
    s:=Rss('http://www.1-y.ru/nic.rss');
    Ннработает:
    Code:
    s:=Rss('http://www.webmoney.ru/rss.xml');
    И почему 2 или 1 новость?
    Можно сделать так чтобы были 5-10 новостей
     
    #1462 -Hormold-, 2 May 2008
    Last edited: 2 May 2008
  3. z01b

    z01b Муджахид

    Joined:
    5 Jan 2007
    Messages:
    494
    Likes Received:
    382
    Reputations:
    22
    Дай полный листинг ошибки или дай проект.
     
    #1463 z01b, 2 May 2008
  4. -Hormold-

    -Hormold- Кто, если не ты?

    Joined:
    29 Sep 2007
    Messages:
    418
    Likes Received:
    290
    Reputations:
    44
    в первом понятно, это из за ошибок в rss ленте.
    А вот это я не понял =(
     
    #1464 -Hormold-, 2 May 2008
  5. KIR@PRO

    KIR@PRO from Exception

    Joined:
    26 Dec 2007
    Messages:
    826
    Likes Received:
    291
    Reputations:
    359
    Привет всем....
    подскажитепожалста как мона прослушать определённый порт на компе.... к примеру у меня на компе прога соеденина с др компом по tcp при помощи чего (не откажусь от кода) можно прослушать обмен между моим компом и др по этому порту... к примеру возьмем порт 80... заранее благодарю....
     
    _________________________
    #1465 KIR@PRO, 2 May 2008
  6. z01b

    z01b Муджахид

    Joined:
    5 Jan 2007
    Messages:
    494
    Likes Received:
    382
    Reputations:
    22
    Компонент idTcpServer - закладка Indy Servers.
     
    #1466 z01b, 2 May 2008
  7. KIR@PRO

    KIR@PRO from Exception

    Joined:
    26 Dec 2007
    Messages:
    826
    Likes Received:
    291
    Reputations:
    359
    а поконкретней можно куском кода.....


    нифига не робит!
     
    _________________________
    #1467 KIR@PRO, 2 May 2008
    Last edited: 2 May 2008
  8. z01b

    z01b Муджахид

    Joined:
    5 Jan 2007
    Messages:
    494
    Likes Received:
    382
    Reputations:
    22
    Поставь конкретную задачу, что тебе нужно.
     
    #1468 z01b, 2 May 2008
  9. KIR@PRO

    KIR@PRO from Exception

    Joined:
    26 Dec 2007
    Messages:
    826
    Likes Received:
    291
    Reputations:
    359
    мне надо смотреть весь трафик на определённом(конкретном) порту при том что у меня на компе этот порт уже открыт.... то есть уже есть соединение от моего компьютера к другому по этому порту и данные с этого порта надо прослушать моей программой.... вроде объяснил понятно....
     
    _________________________
    #1469 KIR@PRO, 2 May 2008
  10. Myst

    Myst Elder - Старейшина

    Joined:
    22 Feb 2008
    Messages:
    22
    Likes Received:
    15
    Reputations:
    5
    Просто используй любой снифер.
     
    #1470 Myst, 2 May 2008
  11. z01b

    z01b Муджахид

    Joined:
    5 Jan 2007
    Messages:
    494
    Likes Received:
    382
    Reputations:
    22
    Вот либы с нужными тебе функций для создания снифера
    http://3d2f.com/programs/39-907-packet-sniffer-sdk-for-windows-download.shtml
     
    #1471 z01b, 3 May 2008
    3 people like this.
  12. reza4ok

    reza4ok New Member

    Joined:
    3 May 2008
    Messages:
    17
    Likes Received:
    1
    Reputations:
    0
    У меня такой вопрос: как в делфи вызвать командную строку(а именно мне нада узнать проходит ли пинг на конкретный айпи); и если проходит то как запрограммировать что бы программа подсчитывала количество пройденных пингов и если прошло нужное количество то загорался бы зелёный кружочек (желательно в трее) если не прошли пинги то красный... В принципе мне нужна такая программа для того что бы знать работает ли у меня и-нет, так как сижу на халяву, но халява не бесконечная... и-нет то обрывается то работает.... и что бы не запускать браузер или командную строку и проверять есть ли соединение мне просто нада написать такую прогу :)
     
    #1472 reza4ok, 4 May 2008
  13. krypt3r

    krypt3r Elder - Старейшина

    Joined:
    27 Apr 2007
    Messages:
    1,507
    Likes Received:
    389
    Reputations:
    101
    ping -t <IP-address> :)
    Или изучать сетевой кодинг и протокол ICMP - отсылать ECHO REQUEST, если пришел ECHO REPLY, то рисовать зеленый кружок, если нет, то... Ну или взять готовый код - пингеров на делфи куча
     
    #1473 krypt3r, 4 May 2008
  14. De-visible

    De-visible [NDC] Network develope c0ders

    Joined:
    6 Jan 2008
    Messages:
    916
    Likes Received:
    550
    Reputations:
    66
    А почему бы тебе просто не автоматизировать этот процесс? SHELLEXECUTE?!
     
    #1474 De-visible, 4 May 2008
    2 people like this.
  15. Jes

    Jes Elder - Старейшина

    Joined:
    16 Apr 2007
    Messages:
    370
    Likes Received:
    391
    Reputations:
    34
    #1475 Jes, 4 May 2008
    Last edited: 4 May 2008
  16. z01b

    z01b Муджахид

    Joined:
    5 Jan 2007
    Messages:
    494
    Likes Received:
    382
    Reputations:
    22
    мде... если он будет юзать ShellExecute, как он отпарсит результат? Только если перенаправить вывод в файл и потом парсить файл или через пайпы, но это тяжело. Легче будет скачать сырцы пингера (их в инете полно) и встроить ф-цию у себя в программе.

    ЗЫ Вот пример пингера

    Code:
    unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,winsock, StdCtrls;

type
IPINFO = record
Ttl :char;
Tos :char;
IPFlags :char;
OptSize :char;
Options :^char;
end;

type
ICMPECHO = record
Source :longint;
Status :longint;
RTTime :longint;
DataSize:Shortint;
Reserved:Shortint;
pData :^variant;
i_ipinfo:IPINFO;
end;
TIcmpCreateFile = function():integer; {$IFDEF WIN32} stdcall; {$ENDIF}
TIcmpCloseHandle = procedure(var handle:integer);{$IFDEF WIN32} stdcall; {$ENDIF}
TIcmpSendEcho = function(var handle:integer; endereco:DWORD; buffer:variant; tam:WORD; IP:IPINFO; ICMP:ICMPECHO; tamicmp:DWORD; tempo:DWORD):DWORD;{$IFDEF WIN32} stdcall; {$ENDIF}

type
TForm1 = class(TForm)
Edit1: TEdit;
Memo1: TMemo;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;





var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
wsadt : wsadata;
icmp :icmpecho;
HNDicmp : integer;
hndFile :integer;
Host :PHostEnt;
Destino :in_addr;
Endereco :^DWORD;
IP : ipinfo;
Retorno :integer;
dwRetorno :DWORD;
x :integer;

IcmpCreateFile : TIcmpCreateFile;
IcmpCloseHandle : TIcmpCloseHandle;
IcmpSendEcho : TIcmpSendEcho;

begin
if (edit1.Text = '') then begin
Application.MessageBox('Enter a HostName ro a IP Adress',
'Error', MB_OK);
exit;
end;
HNDicmp := LoadLibrary('ICMP.DLL');
if (HNDicmp <> 0) then begin
@IcmpCreateFile := GetProcAddress(HNDicmp,'IcmpCreateFile');
@IcmpCloseHandle := GetProcAddress(HNDicmp,'IcmpCloseHandle');
@IcmpSendEcho := GetProcAddress(HNDicmp,'IcmpSendEcho');
if (@IcmpCreateFile=nil) or (@IcmpCloseHandle=nil) or (@IcmpSendEcho=nil) then begin
Application.MessageBox('Error getting ICMP Adress','Error', MB_OK);
FreeLibrary(HNDicmp);
end;
end;
Retorno := WSAStartup($0101,wsadt);

if (Retorno <> 0) then begin
Application.MessageBox('Can´t Load WinSockets','WSAStartup', MB_OK);
WSACleanup();
FreeLibrary(HNDicmp);
end;

Destino.S_addr := inet_addr(Pchar(Edit1.text));
if (Destino.S_addr = 0) then begin
Host := GetHostbyName(PChar(Edit1.text));
end
else begin
Host := GetHostbyAddr(@Destino,sizeof(in_addr), AF_INET);
end;

if (host = nil) then begin
Application.MessageBox('Host not found','Error', MB_OK);
WSACleanup();
FreeLibrary(HNDicmp);
exit;
end;
memo1.Lines.Add('Pinging ' + Edit1.text);

Endereco := @Host.h_addr_list;

HNDFile := IcmpCreateFile();
for x:= 0 to 4 do begin
Ip.Ttl := char(255);
Ip.Tos := char(0);
Ip.IPFlags := char(0);
Ip.OptSize := char(0);
Ip.Options := nil;

dwRetorno := IcmpSendEcho(
HNDFile,
Endereco^,
null,
0,
Ip,
Icmp,
sizeof(Icmp),
DWORD(5000));
Destino.S_addr := icmp.source;
Memo1.Lines.Add('Ping ' + Edit1.text);
end;


IcmpCLoseHandle(HNDFile);
FreeLibrary(HNDicmp);
WSACleanup();
end;

end.
     
    #1476 z01b, 4 May 2008
    Last edited: 4 May 2008
  17. begin_end

    begin_end Green member

    Joined:
    4 Jan 2007
    Messages:
    265
    Likes Received:
    638
    Reputations:
    476
    Ежели нужно получить результат работы именно консольного приложения, то может помочь следующая функция:
    Code:
    procedure ExecConsoleApp(CommandLine: AnsiString; Output: TStringList; Errors:
  TStringList);
var
  sa: TSECURITYATTRIBUTES;
  si: TSTARTUPINFO;
  pi: TPROCESSINFORMATION;
  hPipeOutputRead: THANDLE;
  hPipeOutputWrite: THANDLE;
  hPipeErrorsRead: THANDLE;
  hPipeErrorsWrite: THANDLE;
  Res, bTest: Boolean;
  env: array[0..100] of Char;
  szBuffer: array[0..256] of Char;
  dwNumberOfBytesRead: DWORD;
  Stream: TMemoryStream;
begin
  sa.nLength := sizeof(sa);
  sa.bInheritHandle := true;
  sa.lpSecurityDescriptor := nil;
  CreatePipe(hPipeOutputRead, hPipeOutputWrite, @sa, 0);
  CreatePipe(hPipeErrorsRead, hPipeErrorsWrite, @sa, 0);
  ZeroMemory(@env, SizeOf(env));
  ZeroMemory(@si, SizeOf(si));
  ZeroMemory(@pi, SizeOf(pi));
  si.cb := SizeOf(si);
  si.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
  si.wShowWindow := SW_HIDE;
  si.hStdInput := 0;
  si.hStdOutput := hPipeOutputWrite;
  si.hStdError := hPipeErrorsWrite;

  (* Remember that if you want to execute an app with no parameters you nil the
    second parameter and use the first, you can also leave it as is with no
    problems.                                                                *)
  Res := CreateProcess(nil, pchar(CommandLine), nil, nil, true,
    CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, @env, nil, si, pi);

  // Procedure will exit if CreateProcess fail
  if not Res then
  begin
    CloseHandle(hPipeOutputRead);
    CloseHandle(hPipeOutputWrite);
    CloseHandle(hPipeErrorsRead);
    CloseHandle(hPipeErrorsWrite);
    Exit;
  end;
  CloseHandle(hPipeOutputWrite);
  CloseHandle(hPipeErrorsWrite);

  //Read output pipe
  Stream := TMemoryStream.Create;
  try
    while true do
    begin
      bTest := ReadFile(hPipeOutputRead, szBuffer, 256, dwNumberOfBytesRead,
        nil);
      if not bTest then
      begin
        break;
      end;
      Stream.Write(szBuffer, dwNumberOfBytesRead);
    end;
    Stream.Position := 0;
    Output.LoadFromStream(Stream);
  finally
    Stream.Free;
  end;

  //Read error pipe
  Stream := TMemoryStream.Create;
  try
    while true do
    begin
      bTest := ReadFile(hPipeErrorsRead, szBuffer, 256, dwNumberOfBytesRead,
        nil);
      if not bTest then
      begin
        break;
      end;
      Stream.Write(szBuffer, dwNumberOfBytesRead);
    end;
    Stream.Position := 0;
    Errors.LoadFromStream(Stream);
  finally
    Stream.Free;
  end;

  WaitForSingleObject(pi.hProcess, INFINITE);
  CloseHandle(pi.hProcess);
  CloseHandle(hPipeOutputRead);
  CloseHandle(hPipeErrorsRead);
end;
    Пример использования.
     
    _________________________
    #1477 begin_end, 4 May 2008
    3 people like this.
  18. desTiny

    desTiny Elder - Старейшина

    Joined:
    4 Feb 2007
    Messages:
    1,006
    Likes Received:
    444
    Reputations:
    94
    Я бы сделал этот участок по-другому:

    Code:
      if not Res then
  begin
    CloseHandle(hPipeOutputRead);
    CloseHandle(hPipeOutputWrite);
    CloseHandle(hPipeErrorsRead);
    CloseHandle(hPipeErrorsWrite);
    Exit;
  end;
  CloseHandle(hPipeOutputWrite);
  CloseHandle(hPipeErrorsWrite);

    Code:
    procedure ExecConsoleApp(CommandLine: AnsiString; Output: TStringList; Errors:
  TStringList);
var
  sa: TSECURITYATTRIBUTES;
  si: TSTARTUPINFO;
  pi: TPROCESSINFORMATION;
  hPipeOutputRead: THANDLE;
  hPipeOutputWrite: THANDLE;
  hPipeErrorsRead: THANDLE;
  hPipeErrorsWrite: THANDLE;
  Res, bTest: Boolean;
  env: array[0..100] of Char;
  szBuffer: array[0..256] of Char;
  dwNumberOfBytesRead: DWORD;
  Stream: TMemoryStream;
begin
try
  sa.nLength := sizeof(sa);
  sa.bInheritHandle := true;
  sa.lpSecurityDescriptor := nil;
  CreatePipe(hPipeOutputRead, hPipeOutputWrite, @sa, 0);
  CreatePipe(hPipeErrorsRead, hPipeErrorsWrite, @sa, 0);
  ZeroMemory(@env, SizeOf(env));
  ZeroMemory(@si, SizeOf(si));
  ZeroMemory(@pi, SizeOf(pi));
  si.cb := SizeOf(si);
  si.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
  si.wShowWindow := SW_HIDE;
  si.hStdInput := 0;
  si.hStdOutput := hPipeOutputWrite;
  si.hStdError := hPipeErrorsWrite;

  (* Remember that if you want to execute an app with no parameters you nil the
    second parameter and use the first, you can also leave it as is with no
    problems.                                                                *)
  Res := CreateProcess(nil, pchar(CommandLine), nil, nil, true,
    CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, @env, nil, si, pi);

  // Procedure will exit if CreateProcess fail
  if not Res then
   raise;

  //Read output pipe
  Stream := TMemoryStream.Create;
  try
    while true do
    begin
      bTest := ReadFile(hPipeOutputRead, szBuffer, 256, dwNumberOfBytesRead,
        nil);
      if not bTest then
      begin
        break;
      end;
      Stream.Write(szBuffer, dwNumberOfBytesRead);
    end;
    Stream.Position := 0;
    Output.LoadFromStream(Stream);
  finally
    Stream.Free;
  end;

  //Read error pipe
  Stream := TMemoryStream.Create;
  try
    while true do
    begin
      bTest := ReadFile(hPipeErrorsRead, szBuffer, 256, dwNumberOfBytesRead,
        nil);
      if not bTest then
      begin
        break;
      end;
      Stream.Write(szBuffer, dwNumberOfBytesRead);
    end;
    Stream.Position := 0;
    Errors.LoadFromStream(Stream);
  finally
    Stream.Free;
  end;

  WaitForSingleObject(pi.hProcess, INFINITE);
finally
  CloseHandle(pi.hProcess);
  CloseHandle(hPipeOutputRead);
  CloseHandle(hPipeErrorsRead);
  CloseHandle(hPipeOutputWrite);
  CloseHandle(hPipeErrorsWrite);
end;
end;
     
    #1478 desTiny, 4 May 2008
    1 person likes this.
  19. Hellsp@wn

    Hellsp@wn Elder - Старейшина

    Joined:
    29 Apr 2007
    Messages:
    401
    Likes Received:
    153
    Reputations:
    48
    если делать такую функцию, то лучше без stream'ов, а чисто на winapi :)
     
    #1479 Hellsp@wn, 4 May 2008
  20. GlOFF

    GlOFF Elder - Старейшина

    Joined:
    8 May 2006
    Messages:
    689
    Likes Received:
    484
    Reputations:
    4
    "[Delphi] Задай вопрос, получи ответ" - тут видимо stream'ы любят :)
     
    #1480 GlOFF, 4 May 2008
    1 person likes this.
(You must log in or sign up to post here.)
Page 74 of 489
Thread Status:
Not open for further replies.
Language
English (US)
    ANTICHAT ™ © 2001-2027 Antichat Kft.