Форум: "Основная";
Текущий архив: 2005.02.27;
Скачать: [xml.tar.bz2];

Вниз

Почемуто все время растет память у процесса .. ?????   Найти похожие ветки 

← →
Single ©   (2005-02-09 15:17) [0]

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.

---

← →
Single ©   (2005-02-09 15:19) [1]

и еще кусок

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:20) [2]

Вот еще кусок кода:
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:22) [3]

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

---

← →
Digitman ©   (2005-02-09 15:41) [4]

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


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

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

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

---

← →
Single ©   (2005-02-09 16:26) [5]

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

---

← →
Anatoly Podgoretsky ©   (2005-02-09 22:08) [6]

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

---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2005.02.27;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.5 MB
Время: 0.281 c