[ Delphi / Pascal ] — начинающим: задаем вопросы

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

 

Смена обоев рабочего стола откопал пример:

Code:

uses ...Registry; //подключаем модуль
...
procedure TForm1.Button1Click(Sender: TObject);
var
Reg: TRegIniFile;
begin
Reg := TRegIniFile.Create('Control Panel');
Reg.WriteString('desktop', 'Wallpaper', 'c:\windows\Установка.bmp');
Reg.WriteString('desktop', 'TileWallpaper', '0');
Reg.Free;
SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, nil, SPIF_SENDWININICHANGE);
end;

Всё круто только картинки с расширением *.png и *.gif не ставит =(

 

Code:

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    Memo1: TMemo;
    Label1: TLabel;
    function duble(const line: string):boolean;
    procedure pars(url:string);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  host:string; q:integer;
implementation

{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var str:string;
begin
str:=edit1.text;
if str[length(str)]='/' then
setlength(str,length(str)-1);
host:=str;
pars(edit1.text);
end;

function TForm1.duble(const line: string):boolean;
var i:integer;
begin
for i:=0 to memo1.Lines.Count-1 do
  if memo1.Lines[i]= line then begin
  result:=true; break; end else result:=false;
end;

procedure TForm1.pars(url: string);
var list:Tstringlist;
reg:TRegExpr;
begin
inc(q);
URLDownloadToFile(nil,Pchar(url),pchar('index'+inttostr(q)+'.html'),0,nil);
list:=Tstringlist.Create;
reg:=TRegExpr.Create;
if FileExists('index'+inttostr(q)+'.html') then
list.LoadFromFile('index'+inttostr(q)+'.html') else exit;

reg.Expression:='[a][\s]{1,}(href=")([^"]+)';
if reg.Exec(list.Text) then
Repeat
  if (reg.Match[2]<>'#')and(not duble(reg.Match[2])) then begin
  memo1.Lines.Add(reg.Match[2]);
  Application.ProcessMessages;
  label1.Caption:=inttostr(memo1.Lines.Count+1);
      if reg.Match[2][1]='/' then
          pars(host+reg.Match[2])
      else if ((copy(reg.Match[2],1,4)='http') and (Pos(host, reg.Match[2])>0)) then
          pars(reg.Match[2])
      else
          pars(host+'/'+reg.Match[2]);
      end;
Until not reg.ExecNext else ShowMessage('Г*ГҐГ*');

//DeleteFile('index'+inttostr(q)+'.html');
list.Free;
reg.Free;

end;
initialization
q:=0;

ругается
[dcc32 Error] Unit1.pas(68): E2251 Ambiguous overloaded call to 'Pos'
System.pas(30215): Related method: function Pos(const WideString; const WideString; Integer): Integer;
System.pas(30055): Related method: function Pos(const string; const string; Integer): Integer;

 

Со вторым аргументом что-то не так значит. Попробуйте его в другую строку записать, а затем получить позицию уже из неё.

 

А можно кодом?)

 

brown, компилятор все же ясно сказал, что ему не нравится, в delphi xe функция System.Pos имеет немного другое количество аргументов. Ну и код конечно лучше писать куда более понятным и простым, те же переменные можно инициализировать сразу (var q: Integer = 0; ), а не в секции initialization; помимо всего есть теоретическая утечка памяти ( if FileExists('index' + inttostr(q) + '.html') then ... else exit; ), выход из процедуры без закрытия ранее открытых TStringList & TRegExpr в случае отсутствия файла ('index' + inttostr(q) + '.html'), имя которого тоже можно было один раз определить в переменной, напримет так: sFileName:= Format('index%d.html', [q]); и дальше использовать ее.

 

Подскажите пробую с помощью Synapse открыть урл
http://212.19.5.123:7088/udp/239.191.254.244:13343

Code:

procedure TForm1.btn1Click(Sender: TObject);
var
  http: THTTPSend;
begin
  http := THTTPSend.Create;
  http.Timeout := 3000;
  http.Sock.SetTimeout(3000);
  http.Sock.ConnectionTimeout := 3000;
  http.Sock.InterPacketTimeout := False;
  http.Sock.NonblockSendTimeout := 3000;
  http.Sock.NonBlockMode := True;

  try
    http.HTTPMethod('GET', 'http://212.19.5.123:7088/udp/239.191.254.244:13343');
    ShowMessage(IntToStr(http.ResultCode));
  finally
    http.Free
  end;
end;

Установил все возможные таймауты в положение 3с.
Но даже по истечении этих 3 секунд закачка продолжается.
Как прервать подключение не создавая дополнительный поток?
По сути мне надо только узнать 1) Код ответа 2) Выдает ли урл файл

 

Использовать метод HEAD вместо GET?

 

Не могу отправить файл на сервер в потоке.
Поток:

Code:

 type
  FThread = Class(TThread)
    filess: string;
private

   public
       // procedure Synch;
     // constructor Create(CreateSuspended: Boolean);
    protected
     Procedure Execute; Override;
   end;
.....
procedure FThread.Execute;
var   IdHTTP2 : TIdHTTP;
      Stream: TIdMultipartFormDataStream;
begin
      filess:= files;
       IdHTTP2 := TIdHTTP.Create;
       Stream:=TIdMultipartFormDataStream.Create;
      try
      Stream.AddFile('faile', filess, '');
      Form1.Memo1.Lines.Add(IdHTTP2.Post(filess, Stream));
     finally
      Stream.Free;
     // form1.Memo1.lines.add(files);
    end;
end;

Вызов:

Code:

procedure TForm1.Button8Click(Sender: TObject);
  var TFThread:TThread;
  begin
if CheckBox3.Checked = true then
   begin
        TFThread:= FThread.Create(true);
        TFThread.FreeOnTerminate:=true;
        TFThread.Priority:=tpNormal;
        TFThread.Resume;
   end;
end;

Вот так отправляет:

Code:

procedure TForm1.Button6Click(Sender: TObject);
var      Stream: TIdMultipartFormDataStream;
  begin
if CheckBox2.Checked = true then
  begin
    Stream := TIdMultipartFormDataStream.Create;
    try
      Stream.AddFile('faile', files, '');
      memo1.Lines.Add(IdHTTP1.Post(Edit1.text, Stream));
    finally
      Stream.Free;
       form1.Memo1.lines.add(files);
    end;

  end;
end;

Где ошибка подскажите?

 

Доброго времени суток. Нужна помощь, так в программировании я, мягко говоря, новичок. Вот код программы в Делфи:

PHP:

var a,b,d,e,i,g,y,xk,xk1:double;
k:integer;
function F(x:double):double;
begin
F:=a+(b/6.28)*(x-e*sin(x))-i;
end;
function F1(x:double):double;
begin
F1:=(b/6.28)*(1-e*cos(x));
end;
begin
a:=strtofloat(edit1.Text);
b:=strtofloat(edit2.Text);
i:=strtofloat(edit3.Text);
d:=strtofloat(edit4.Text);
e:=strtofloat(edit5.Text);
g:=strtofloat(edit6.Text);
y:=F(xk);
while abs(y)<=0.001 do
begin
xk1:=xk-F(xk)/F1(xk);
xk:=xk1;
y:=F(xk1);
end;
edit7.Text:=floattostr(xk1);
end.

Я не могу исправить возникающие ошибки и мне необходимо, чтобы помимо решения уравнения для заданных параметров программа перебирала все значения переменной i в интервале от 0 до значения переменной b.

 

for i:=0 to b
do {что-то делаем}

 

какие ошибки то возникают, а вообще не мешало бы описать условия задачи, а то по этому коду особо и не поймешь, что необходимо рассчитать. Да и переменные не помешало бы сперва инициализировать ( y:= F(xk); )

 

Задача звучит так:
Известны и задаются изначально T, tay и e.

Необходимо найти множество значений Е на интервале времени t.

t изменяется в диапазоне от 0 до Т(период)

Е – угол

Исходное уравнение:

0=tay+(T/2П)*(E-e*sin(E))-t

Это уравнение возможно решить только численно.

Потом полученное множество значений Е используется для нахождения двух промежуточных и двух искомых углов, но мне хотя бы с циклом разобраться

 

Тогда надо будет b, т.е. период задать в integer? Ведь он иначе выдаёт ошибку.

 

Почему не правильно отправляет пакет ?

Code:

function HexToStr(s:pchar):string;
begin
   SetLength(Result,StrLen(s)div 2);
   SetLength(Result,HexToBin(s, @result[1],StrLen(s)div 2));
end;
...
IdUDPClient1.Send(HexToStr(pchar(Memo1.text)));

 

Зачем два раза устанавливать длину строки (SetLength)?

В последнем случае явно должна быть просто запись строки в Result.

 

Понимаешь просто вместо FF отправляется 3F и функции hextostr все перепробовал одно и тоже ...

 

Я не понимаю двух вещей - зачем два раза устанавливать длину строки (SetLength), и почему выше приведённый код вообще работает (он не логичен). Ответьте сначала на первый вопрос.

 

Этот код не я писал хз ) да и я тебе говорю что все hextostr перепробовал и всегда вместо FF отправка 3F

 

Понятно, как всегда.

Попробуй использовать другие методы отправки, просто Send может применяться для других случаев.

И отлаживай, смотри что в буфере по указателю! Никто никогда не гарантирует правильность работы таких функций.