Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Базы";
Текущий архив: 2005.09.18;
Скачать: [xml.tar.bz2];

Вниз

Ненормальный размер файла БД   Найти похожие ветки 

 
Зёма   (2005-08-08 02:37) [0]

Получаю email через IdPOP3 и сохраняю в БД Access с помощью такого кода :

procedure TPostRec.AddtoDB(pmess:TIdMessage);
var bs:TADOBlobstream;
begin
atab.Open;
atab.Insert;
bs:=TADOBLOBStream(atab.CreateBLOBStream(atab.FieldByName("message"),bmwrite));
pmess.SaveToStream(bs);
bs.Free;
atab.Post;
atab.Close;
end;

При добавлении около 2 мб данных размер mdb-файла составляет около 75 мб !!!
В каком месте я изобрел грабли ?


 
Slym ©   (2005-08-08 09:00) [1]

Сожми базу и пробуй еще...


 
Anatoly Podgoretsky ©   (2005-08-08 09:12) [2]

TIdMessage = class(... и никаких SaveToStream не наблюдается.


 
Зёма   (2005-08-08 13:54) [3]

упаковку я естественно пробовал - не помогает
Этот же код нормально работал с Paradox
Что интересно, если открыть файл базы в Notepad++, обнаруживается куча NULL-символов

Приведу дополнительные сведения :
Connection String :Provider=Microsoft.Jet.OLEDB.4.0;User ID=Admin;
Data Source=C:\db\test.mdb;Mode=Share Deny None;Extended Properties="";
Jet OLEDB:System database="";
Jet OLEDB:Registry Path="";Jet OLEDB:Database Password="";
Jet OLEDB:Engine Type=5;Jet OLEDB:Database Locking Mode=1;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;
Jet OLEDB:New Database Password="";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;
Jet OLEDB:Don"t Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False

Код модуля с классом для получения почты :

unit Unit2;

interface
uses
  messages, StdCtrls,idthread, DB, DBTables,  IdMessage,IdPOP3, ADODB,SysUtils, Variants, Classes;

type
 params=record
  boxname:string;
  username:string;
  password:string;
  host:string;
  userid:string;
  port:integer;
end;

type
  TPostRec=class(TIdThread)
    userdata:params;
    atab:TADOTable;
    acon:TADOConnection;
    mess:TIdMessage;
    pop:TIdPOP3;
    procedure AddToDB(pmess:TIdMessage);
    function GetBoxname():string;
    procedure Run; override;
    public
    constructor Create(CreateSuspennded: Boolean;fdata:params;mcon:TADOConnection);
    destructor Destroy; override;
end;

var
 user:params;
 const tr:integer=2;
 const th_max:integer=2;
 const tmr:integer=0;
 const tm_out:integer=-1;
 const def_pause:integer=600000;
implementation

constructor TPostRec.Create(CreateSuspennded: Boolean;fdata:params;mcon:TADOConnection);
begin

inherited Create(CreateSuspennded);

userdata:=fdata;
acon:=TADOConnection.Create(nil);
acon:=mcon;

atab:=TADOTable.Create(nil);
atab.Connection:=acon;
atab.TableName:=userdata.boxname;

mess:=TIdMessage.Create(nil);

pop:=TIdPOP3.Create(nil);
pop.username:=userdata.username;
pop.Password:=userdata.password;
pop.Host:=userdata.host;
pop.Port:=userdata.port;

end;

destructor TPostRec.Destroy;
begin
acon.Close;
acon.Free;

atab.Close;
atab.Free;

mess.Free;
pop.Disconnect;
pop.Free;

end;

function TPostRec.GetBoxname():string;
begin
result:=userdata.boxname;
end;

procedure TPostRec.AddtoDB(pmess:TIdMessage);
var bs:TADOBlobstream;
begin
atab.Open;
atab.Insert;
bs:=TADOBLOBStream(atab.CreateBLOBStream(atab.FieldByName("message"),bmwrite));
pmess.SaveToStream(bs);
bs.Free;
atab.Post;
atab.Close;
end;

procedure TPostRec.Run;
var count:integer;
   i,messcount:integer;
   resflag:boolean;
begin

//sleep(1000);

resflag:=false;
count:=0;
while (count<>tr)and (resflag=false) do
begin
 try
  pop.Connect(tm_out);
  messcount:=pop.CheckMessages;
  resflag:=true;
   if messcount<>0 then
     for i:=1 to messcount do
      begin
       pop.Retrieve(i,mess);
       pop.Delete(i);
       AddToDB(mess);
      end;
   pop.Disconnect;
  except
   inc(count);
  end;
end;    
Stop;

end;

end.

-------------------------------------------


 
Slym ©   (2005-08-08 14:11) [4]

Зёма   (08.08.05 13:54) [3]
Совсем херово
constructor TPostRec.Create(CreateSuspennded: Boolean;fdata:params;mcon:TADOConnection);
begin
inherited Create(CreateSuspennded);
userdata:=fdata;
acon:=TADOConnection.Create(nil);
acon:=mcon;//Это что?! Это лажа!
end;


 
Slym ©   (2005-08-08 14:13) [5]

И второе...
IdMessage Сильно коверкает сообщения! не пользуй его!


 
Slym ©   (2005-08-08 14:37) [6]

procedure Run(MailBoxParams:TMailBoxParams;Con:TADOConnection);
var
 IdPOP3:TIdPOP3;
 MsgCount,i,x:longint;
 Table:TADOCommand;
 AMsg: TStringList;
 FileName:string;
 error:boolean;
begin
 IdPOP3:=TIdPOP3.Create(nil);
 try
   IdPOP3.username:=MailBoxParams.username;
   IdPOP3.Password:=MailBoxParams.password;
   IdPOP3.Host:=MailBoxParams.host;
   IdPOP3.Port:=MailBoxParams.port;
   IdPOP3.Connect;
   MsgCount:=IdPOP3.CheckMessages;
   if MsgCount>0 then
   begin
     Table:=TADOCommand.Create(nil);
     try
       Table.Connection:=Con;
       Table.CommandText:="INSERT INTO "+MailBoxParams.boxname+" ([Message]) VALUES (:Message);";
       Table.Prepared:=true;
       AMsg:=TStringList.Create;
       try
         for i:=1 to MsgCount do
         begin
           AMsg.Clear;
           if not IdPOP3.RetrieveRaw(i,AMsg) then Raise Exception.Create("Can""t retrieve message");

           Table.Parameters[0].Value:=AMsg.Text;
           Table.Execute;
           if not IdPOP3.Delete(i) then Raise Exception.Create("Can""t delete message");
         end;
       finally
         AMsg.Free;
       end;
     finally
       Table.Free;
     end;
   end;
 finally
   IdPOP3.Free;
 end;
end;


 
Зёма   (2005-08-08 15:00) [7]

Мда ...
Я тоже нашел
TIdMessage нужно очищать перед использованием
Вопрос можно считать закрытым



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

Форум: "Базы";
Текущий архив: 2005.09.18;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.47 MB
Время: 0.018 c
4-1122302673
Smile666
2005-07-25 18:44
2005.09.18
Обработка исключения (API)!


14-1125004177
ronyn
2005-08-26 01:09
2005.09.18
Как защитить программу


1-1125055148
MrTime
2005-08-26 15:19
2005.09.18
Класс для работы с файлом собственной структуры


1-1124787869
B-boy-Dimo-N
2005-08-23 13:04
2005.09.18
конфликт между JCL+JVCL 2.10 и QReport 4


4-1121936114
supervk
2005-07-21 12:55
2005.09.18
проверка готовности принтера LPT





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский