| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Почемуто все время растет память у процесса .. ????? [D7, WinXP]

Single ©   (2005-02-09 15:17:00) 

procedure TServiceDrWebUp.TcpServer1Accept(Sender: TObject; ClientSocket: TCustomIpClient);
var
 Name, DataType, CurDate, LastDate: String;
 DataLen: Integer;
 Head: TStrings;
 SHead: TStrings;
 Str: String;
 Refresh: Boolean;
 SocketFree: Boolean;
 FieldStream: TStream;
 DocStream: TMemoryStream;
 ServerSocket: TTcpClient;
 Q: TADOQuery;
 Max,Len: integer;
 Buf: array[0..1025] of byte;

 procedure RefreshSQLAll;
 begin
   Q.SQL.Text:='UPDATE "DBA"."Data" SET "Refresh"=''True''';
   Q.ExecSQL;
 end;

 procedure RefreshSQL;
 begin
  // if Name='drweb32.lst' then exit;
   Q.SQL.Text:='UPDATE "DBA"."Data" SET "Refresh"=''False'' WHERE "Name" = '''+Name+'''';
 end;

 procedure SaveNew;
 begin
   Q.SQL.Text:='SELECT "Name" FROM "DBA"."Data" WHERE "Name" = '''+Name+'''';
   Q.Open;
   if Q.IsEmpty then
   begin
     Q.Close;
     Q.SQL.Text:='INSERT INTO "DBA"."Data" ("Name", "Data", "Date", "Refresh", "DataType") '+
                 'VALUES ('''+Name+''', :Data, '''+LastDate+''', ''False'', '''+DataType+''')';
   end else begin
     Q.Close;

     Q.SQL.Text:='UPDATE "DBA"."Data" SET "Name" = '''+Name+''', "Data" = :Data, '+
                 '"Date" = '''+LastDate+''', "Refresh" = ''False'', "DataType" = '''+DataType+''''+
                 'WHERE "Name" = '''+Name+'''';
   end;
   Q.Parameters.ParamByName('Data').LoadFromStream(DocStream,ftBlob);
   Q.ExecSQL;
 end;

 procedure SendHead;
 var
   st: TSYSTEMTIME;
 begin
   GetSystemTime(st);
   CurDate:=wdays[st.wDayOfWeek]+', '+IntToStr(st.wDay)+' '+monthnames[st.wMonth]+' '+
            IntToStr(st.wYear)+' '+IntToStr(st.wHour)+':'+IntToStr(st.wMinute)+':'+
            IntToStr(st.wSecond)+' GMT';
   ClientSocket.Sendln('HTTP/1.1 200 The requested document follow');
   ClientSocket.Sendln('Date: '+CurDate);
   ClientSocket.Sendln('Server: Apache/1.3.31 (Unix) mod_ssl/2.8.19 OpenSSL/0.9.7d mod_perl/1.29 PHP/4.3.8');
   ClientSocket.Sendln('X-DrWeb-Server-Name: update.drweb.com');
   ClientSocket.Sendln('X-DrWeb-Validate: Access granted');
   ClientSocket.Sendln('Cache-Control: no-cache');
   ClientSocket.Sendln('Content-Length: '+IntToStr(DataLen));
   ClientSocket.Sendln('Last-Modified: '+LastDate);
   ClientSocket.Sendln('Keep-Alive: timeout=15, max=100');
   ClientSocket.Sendln('Connection: Keep-Alive');
   ClientSocket.Sendln('Content-Type: '+DataType);
   ClientSocket.Sendln('');
 end;

 procedure SendServerHead(Command: String);
 begin
   ServerSocket.Sendln(Command+' /windows/'+Name+' HTTP/1.1');
   ServerSocket.Sendln('Accept: */*');
   ServerSocket.Sendln('Host: update.drweb.com');
   ServerSocket.Sendln('User-Agent: Delphi 7.0');
   ServerSocket.Sendln('Connection: Keep-Alive');
   ServerSocket.Sendln('Cache-Control: no-cache');
   ServerSocket.Sendln('Authorization: Basic Здесь должен быть логин и пароль');
   ServerSocket.Sendln('');
 end;

 procedure AskRefresh;
 begin
   try
     Q.SQL.Text:='SELECT "Refresh" FROM "DBA"."Data" WHERE "Name" = '''+Name+'''';
     Q.Open;
     if not(Q.IsEmpty) then
     begin
       Q.RecordSet.MoveFirst;
       Str:=VarToStr(Q.RecordSet.Fields[0].Value);
       if Str='False' then Refresh:=False;
     end;
   finally
     Q.Close;
   end;
 end;

begin

 Head:=nil;
 SHead:=nil;
 FieldStream:=nil;
 DocStream:=nil;
 ServerSocket:=nil;
 Q:=nil;

 try
   Head:=GetHttpHead(ClientSocket);
   Str:=Head.Strings[0];
   Str:=copy(Str, 0, 36);
   SocketFree:=False;
   if Str='GET http://update.drweb.com/windows/' then
   begin
     Q:=TADOQuery.Create(nil);
     DocStream:=TMemoryStream.Create;

     Q.Connection:=ADOConnection1;
     Refresh:=True;
     Str:=Head.Strings[0];
     Name:=copy(Str, 37, (Length(Str)-45));

     AskRefresh;

     if Name='drweb32.lst' then Refresh:=True;

     SocketFree:=Refresh;

     if Refresh then
     try
       ServerSocket:=TTcpClient.Create(nil);
       ServerSocket.RemoteHost:='update.drweb.com';
       ServerSocket.RemotePort:='80';
       ServerSocket.Connect;
       if ServerSocket.Connected then
       begin
         SendServerHead('HEAD');
         SHead:=GetHttpHead(ServerSocket);
         if 'HTTP/1.1 200 The requested document follow'=SHead.Strings[0] then
         begin
           Q.SQL.Text:='SELECT "Date" FROM "DBA"."Data" WHERE "Name" = '''+Name+'''';
           Q.Open;
           if not(Q.IsEmpty) then
           begin
             Q.RecordSet.MoveFirst;
             Str := VarToStr(Q.RecordSet.Fields[0].Value);
             if Str=SHead.Values['Last-Modified'] then
             begin
               Refresh:=False;
               RefreshSQL;
             end;
           end;
         end else exit;
       end;
     finally
       ServerSocket.Disconnect;
       Q.Close;
     end;

     if Refresh then
     begin
       ServerSocket.Connect;
       if ServerSocket.Connected then
       begin
         SendServerHead('GET');
         SHead:=GetHttpHead(ServerSocket);
         if 'HTTP/1.1 200 The requested document follow'=SHead.Strings[0] then
         begin
           LastDate:=SHead.Values['Last-Modified'];
           DataType:=SHead.Values['Content-Type'];
           DataLen:=StrToInt(SHead.Values['Content-Length']);
           SendHead;

           Max:=DataLen;
           repeat
             if Max>1024 then Len:=1024 else Len:=Max;
             Len:=ServerSocket.PeekBuf(buf, len);
             if len>0 then
             begin
               ServerSocket.ReceiveBuf(buf, len);
               ClientSocket.SendBuf(buf, len);
               DocStream.WriteBuffer(Buf, len);
               Max:=Max-Len;
               sleep(250);
             end;
           until (len < 1) or (0 = Max);
           if Max=0 then SaveNew;
         end;
       end;
     end else begin
       Q.SQL.Text:='SELECT "Data", "Date", "DataType" FROM "DBA"."Data" WHERE "Name" = '''+Name+'''';
       Q.Open;
       if not(Q.IsEmpty) then
       begin
         FieldStream:=Q.CreateBlobStream(Q.FieldByName('Data'),bmRead);
         try
           DocStream.LoadFromStream(FieldStream);

           LastDate:=VarToStr(Q.FieldValues['Date']);
           DataType:=VarToStr(Q.FieldValues['DataType']);
           DataLen:=DocStream.Size;
           SendHead;

           ClientSocket.SendStream(DocStream);
           ClientSocket.Disconnect;
         finally
           Q.Close;
         end;
       end;
     end;

     if (Refresh and (Name='drweb32.lst')) then
     begin
       RefreshSQLAll;
     end;
   end;
 finally
   Head.Free;
   SHead.Free;
   FieldStream.Free;
   DocStream.Free;
   ServerSocket.Free;
   Q.Free;
 end;

end;

end.

---

Anatoly Podgoretsky   (2005-02-09 22:08:00) [1]

Single ©   (09.02.05 15:17)  
У тебя еще текст есть, а то как то несерьезно, очень мало.
И ты бы поосторожнее с наездами, без штанов останешься.
Ну не зочешь и не надо, не сиди, никто не заставляет.
Кстати если хочешь решить задачу, то найми сидельщика.

---

Single   (2005-02-09 16:26:00) [2]

Млин, не нравится не смотри, тебе от этого хуже не станет !!!
Конкретно тебя я непросил!!!
А сидеть пол дня с отладчиком ждать пока программа наберет вес, и то наберет ли ??? тоже вопрос .... а оссобо нехочу, а кто то может уже с подобной проблемой сталкивался ....

---

Digitman   (2005-02-09 15:41:00) [3]

> Почемуто все время растет память у процесса


угу .. не царское это дело - пользовать встроенный в Делфи отиладчик ..

нехай лучше кто-то раком встанет. но найдет во всей этой галиматье якобы ошибку ..

да славен будет делфи-программер, халявой озаренный !

---

Single   (2005-02-09 15:22:00) [4]

Данная программа должна просто у себя в БД хранить обновления для ДрВеба и раздавать их народу , в котором поставлено их брать через прокси .... (в качестве прокси указан порт ServerSocket-та)

---

Single   (2005-02-09 15:20:00) [5]

Вот еще кусок кода:
function ReceivelnEx(Socket: TCustomIpClient; const eol: string = CRLF): string;
var
 len: Integer;
 buf: array[0..511] of char;
 eolptr: pchar;

 procedure Recive;
 begin
   buf[len] := #0;
   eolptr := strpos(buf, pchar(eol));
   if eolptr <> nil then
     len := eolptr - buf + length(eol);
   Socket.ReceiveBuf(buf, len);
   if eolptr <> nil then
     len := len - length(eol);
   buf[len] := #0;
   Result := Result + buf;
 end;

begin
 Result := '';
 eolptr := nil;
 len := Socket.PeekBuf(buf, sizeof(buf) - 1);
 if len > 0 then
   Recive
 else begin
   Result := eol;
   Socket.Disconnect;
   Exit;
 end;
 if eolptr <> nil then exit;
 repeat
   len := Socket.PeekBuf(buf, sizeof(buf) - 1);
   if len > 0 then Recive;
 until (len < 1) or (eolptr <> nil);
end;

function GetHttpHead(Socket: TCustomIpClient): TStringList;
var
 Str: String;
begin
 result := TstringList.Create;
 if Socket.Connected then
 repeat
   Str := ReceiveLnEx(Socket);
   if Str='' then
     result.Add('OK')
    else
     result.Add(StringReplace(Str, ': ', '=', []));
 until Str='';
end;

const
 wdays: array[1..7] of string = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri' , 'Sat');
 monthnames: array[1..12] of string = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',  'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');

---

Single   (2005-02-09 15:19:00) [6]

и еще кусок

function ReceivelnEx(Socket: TCustomIpClient; const eol: string = CRLF): string;
var
 len: Integer;
 buf: array[0..511] of char;
 eolptr: pchar;

 procedure Recive;
 begin
   buf[len] := #0;
   eolptr := strpos(buf, pchar(eol));
   if eolptr <> nil then
     len := eolptr - buf + length(eol);
   Socket.ReceiveBuf(buf, len);
   if eolptr <> nil then
     len := len - length(eol);
   buf[len] := #0;
   Result := Result + buf;
 end;

begin
 Result := '';
 eolptr := nil;
 len := Socket.PeekBuf(buf, sizeof(buf) - 1);
 if len > 0 then
   Recive
 else begin
   Result := eol;
   Socket.Disconnect;
   Exit;
 end;
 if eolptr <> nil then exit;
 repeat
   len := Socket.PeekBuf(buf, sizeof(buf) - 1);
   if len > 0 then Recive;
 until (len < 1) or (eolptr <> nil);
end;

function GetHttpHead(Socket: TCustomIpClient): TStringList;
var
 Str: String;
begin
 result := TstringList.Create;
 if Socket.Connected then
 repeat
   Str := ReceiveLnEx(Socket);
   if Str='' then
     result.Add('OK')
    else
     result.Add(StringReplace(Str, ': ', '=', []));
 until Str='';
end;

const
 wdays: array[1..7] of string = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri' , 'Sat');
 monthnames: array[1..12] of string = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',  'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');

---

Наверх