Avatar billede sabine Nybegynder
02. januar 2003 - 14:16 Der er 34 kommentarer og
2 løsninger

Til Jens B

Jens du skrev i et af mine spørsmål at jeg skulle holde mig til de mere hardcore ting som du kunne svare på

så her er et (tror jeg nok)

Jeg har lavet et email program hvor jeg gemmer mails'ne på harddisken, men er det sådan at jeg godt kunne tænke mig at gemme alle mine mails i en fil ligesom outlook gør i sin pst fil, men jeg ved ikke hvordan da mails'ne har forskællige længder og jeg har ikke løst til at bruge BDE til den opgave.

har du eller i andre et forslag hvordan det skal gøres ??
Avatar billede borrisholt Novice
02. januar 2003 - 14:25 #1
Jow da du kan enten ligge dem i en Database, Interbase fx. eller du kan lave en FileOfRecords ikke helt simpelt File of .... men næsten ...

Fordele ved det første er at du kan søge i dem vha SQL. Fordelen ved det ander er du selv bestemmer dit filformat, og der med kan komprimere det og gøre ved på det....

Sig frem hvad du ønsker :-)

Jens B
Avatar billede morten_s Nybegynder
02. januar 2003 - 14:29 #2
Her har du et link til en DB som består af en "flad" fil, kræver ikke BDE eller ande DB motor, kan varmt anbefales
Avatar billede morten_s Nybegynder
02. januar 2003 - 14:37 #3
Linket er her

http://www.volgadb.com
Avatar billede sabine Nybegynder
02. januar 2003 - 14:39 #4
Hej og godt nyt år alle sammen

Jens det med FileOfRecords lyder som at det er det jeg har brug for kunne du lave et lille eksempel

Morten_s hvor er linket
Avatar billede borrisholt Novice
02. januar 2003 - 14:45 #5
sabine >> Post lige den record der indeholder en Mail, hvis jeg skal lave noget kan det joligeså godt kunne bruges fra starten
Avatar billede borrisholt Novice
02. januar 2003 - 14:47 #6
men prøv VolgaDB først det ser meget lovende ud
Avatar billede zerohero Nybegynder
02. januar 2003 - 14:47 #7
Gemme/Hente egen fil format:

type
  TMinEgenFormat = record
    Message : string[255];
    Indsæt hvad du nu har lyst til...Lav eventuelt en mini-database...
  end;

procedure GemFil(FileName : string);
var
  W : TMinEgenFormat;
  F : file of TMinEgenFormat;
begin
  AssignFile(F,FileName);
  Rewrite(F);
  try
    Write(F, W);
  finally
    CloseFile(F);
  end;
end;

funtion HentFil(FileName : string) : TMinEgenFormat;
var
  R : TMinEgenFormat;
  F : file of TMinEgenFormat;
begin
  if FileExists(FileName) then
  begin
    AssignFile(F,FileName);
    Reset(F);
    try
      while not Eof(F) do
      Read(F, R);
      Result := R;
    finally
      CloseFile(F);
    end;
  end
  else
    ShowMessage('Filen eksistere ikke!');
end;

Held og Lykke
ZeroHero
Avatar billede sabine Nybegynder
02. januar 2003 - 14:50 #8
Jeg bruger ikke en record, jeg henter bare mail'en ned fra server i en stringlist og der efter gemmer den som et tekst fil
Avatar billede morten_s Nybegynder
02. januar 2003 - 14:51 #9
JensB> Ja den er ikke så dårlig, men den er bedst til Tabel, SQL er endnu ikke færdigimplementeret
Avatar billede zerohero Nybegynder
02. januar 2003 - 14:57 #10
Jamen det er jo slet ikke så svært bare kopiér din TStingList til en record og gem dem, som jeg har vist før... Bare et forslag!
Avatar billede sabine Nybegynder
02. januar 2003 - 15:02 #11
Menge tak ZeroHero
men beskeden kan godt indeholde mere end 255 tegn, den type record som jeg
skal bruge skal være variable i længden.

indtil nu har jeg bare gemt mail'en som en tekst fil og hver gang jeg åbner den paser jeg den, før den bliver vist, jeg ved godt at det ikke er den smarteste måde at gøre det på, men det var den der var letteste, jeg er åben for alle forslag også selv om, jeg så skal omskrive den måde jeg henter mails'ne på
Avatar billede zerohero Nybegynder
02. januar 2003 - 15:05 #12
Kan jeg se koden der gemmer din maillist... måske jeg kan finde på noget...
Avatar billede sabine Nybegynder
02. januar 2003 - 15:08 #13
VolgaDB ser ok ud. men jeg ville gerne selv lære det andet, det er et hængepati som jeg gerne ville af med, jeg har aldrig brugt dynamiske records eller hvad man nu kalder dem, så jeg vil meget gerne undgå at bruge andres komponenter, da det så tvinger mig til at lære det.
Avatar billede sabine Nybegynder
02. januar 2003 - 15:09 #14
ZeroHero 2 sek skal lige finde den frem
Avatar billede sabine Nybegynder
02. januar 2003 - 15:35 #15
Denne rutine bruger jeg til at hente, sende og slette mail'en med

procedure TOnlineThread.Execute;
var
  ProtType, S1, S2: String;
  I, Count, Nb, Dt, CIndex: Integer;
  B: Boolean;
begin
  Priority := tpNormal;
  try
    while CommandCount > 0 do begin
      ProtType := GetNextCommand;
      Name := GetNextCommand;
      Server := GetNextCommand;
      Port := GetNextCommand;
      User := GetNextCommand;
      Pass := GetNextCommand;
      Sender := GetNextCommand;
      StandardDownload := GetNextCommand;
      DeleteFilter := GetNextCommand;
      KeepFilter := GetNextCommand;
      AccPath := GetNextCommand;
      NodePtr := GetNextCommand;
      //Ask for POP3 password
      if ProtType = 'POP3' then
      Synchronize(AskForPOPPassword);
      if Aborted then Exit;
      //Connect to server
      WinSocket := TWinSocket.Create(Application);
      WinSocket.Parent := OnlineForm;
      WinSocket.OnError := OnWinSocketError;
      WinSocket.OnClose := OnWinSocketClose;
      WinSocket.BlockTime := 0;
      WinSocket.Blocking := True;
      WinSocket.PortName := Port;
      WinSocket.HostName := Server;
      WinSocket.Open;
      if Aborted then Exit;
      AddToLog(1, 'Connected to '+Server+' at port '+Port);
      if ProtType = 'SMTP' then begin
      // Simple Mail Transfer Protocol
        UsingProtSMTP := True;
        IsSMTPOK(AddToLog(3, Receive));
        SetStatusString(71, '', '');
        if Aborted then Exit;
        Send(AddToLog(2, 'HELO '+GetLocalHostName));
        if Aborted then Exit;
        IsSMTPOK(AddToLog(3, Receive));
        Count := StrToInt(GetNextCommand);
        for I := 0 to Count-1 do begin
          S1 := GetNextCommand;
          if Aborted then Exit;
          if PrepareMailForSending(S1) then begin
            SetStatusString(72, '', '');
            if Aborted then Exit;
            Send(AddToLog(2, 'MAIL FROM:'+Sender));
            if Aborted then Exit;
            IsSMTPOK(AddToLog(3, Receive));
            while SLItemCount > 0 do begin
              if Aborted then Exit;
              Send(AddToLog(2, 'RCPT TO:'+GetNextSLItem));
              if Aborted then Exit;
              IsSMTPOK(AddToLog(3, Receive));
            end;
            SetStatusString(73, '', '');
            if Aborted then Exit;
            Send(AddToLog(2, 'DATA'));
            if Aborted then Exit;
            IsSMTPOK(AddToLog(3, Receive));
            if Abort then Exit;
            AssignFile(F, FFilename);
            Reset(F);
            while not EoF(F) do begin
              if Aborted then begin
                CloseFile(F); RenameFile(FFilename, FOldFilename); Exit;
              end;
              ReadLn(F, S2);
              if S2 = '.' then S2 := '..';
              Send(AddToLog(2, S2));
              SetCounter(Length(S2)+2);
            end;
            SetCounter(-1);
            try CloseFile(F); except end;
            if Aborted then Exit;
            Send(AddToLog(2, ''));
            Send(AddToLog(2, '.'));
            SetStatusString(74, '', '');
            if Aborted then Exit;
            IsSMTPOK(AddToLog(3, Receive));
            if Aborted then Exit;
            Inc(SendMailCount);
            try
              CopyFile(PChar(FFilename), PChar(sRepositoryFolder+ExtractFileName(FOldFilename)), False);
              DeleteFile(PChar(FFilename));
            except end;
          end;
        end;
        SetStatusString(70, '', '');
        if Aborted then Exit;
        UsingProtSMTP := False;
        Send(AddToLog(2, 'QUIT'));
        IsSMTPOK(AddToLog(3, Receive));
        WinSocket.Close;
      end;

      if ProtType = 'POP3' then begin
      // Post Office Protocol Vers. 3
        UsingProtPOP3 := True;
        SetStatusString(64, Server, '');
        if Aborted then Exit;
        IsPOPOK(AddToLog(3, Receive));
        SetStatusString(65, '', '');
        if Aborted then Exit;
        Send(AddToLog(2, 'USER '+User));
        if Aborted then Exit;
        IsPOPOK(AddToLog(3, Receive));
        if Aborted then Exit;
        Send('PASS '+Pass);
        AddToLog(2, 'PASS ********');
        if Aborted then Exit;
        IsPOPOK(AddToLog(3, Receive));
        SetStatusString(66, '', '');
        if Aborted then Exit;
        //Clear Msg List
        FPOPMailListItem := '';
        Synchronize(AddPOPMailToList);
        //List mails
        Count := 0;
        B := False;
        if Aborted then Exit;
        Send(AddToLog(2, 'LIST'));
        if Aborted then Exit;
        S1 := AddToLog(3, Receive);
        if UpperCase(Copy(S1, 1, 3)) = '+OK' then B := True;
        if B then begin
          // Get Mail Count/Size
          if Aborted then Exit;
          S1 := AddToLog(3, Receive);
          while  S1 <> '.' do begin
            FPOPMailListItem := S1;
            Inc(Count);
            Synchronize(AddPOPMailToList);
            if Aborted then Exit;
            S1 := AddToLog(3, Receive);
          end;
          for I := 0 to Count-1 do begin
            SetStatusString(67, IntToStr(I+1), IntToStr(Count));
            GetPOPMailListItem(I, Nb, Dt);
            if Aborted then Exit;
            Send(AddToLog(2, 'TOP '+IntToStr(Nb)+' 0'));
            if Aborted then Exit;
            IsPOPOK(AddToLog(3, Receive));
            if Aborted then Exit;
            FDummy1 := -1;  Synchronize(FParsePOPMailHeader); // Clear StringList
            S1 := AddToLog(3, Receive);
            while  S1 <> '.' do begin
              if S1 = '..' then S1 := '.';
              FSLItem := S1;
              Synchronize(FAddSLItem);
              if Aborted then Exit;
              S1 := AddToLog(3, Receive);
            end;
            FDummy1 := I;
            Synchronize(FParsePOPMailHeader);
          end;
          if Count > 0 then Synchronize(FUserChoosesPOPMail);
          if Aborted then Exit;
          //Download Mail
          CIndex := 1;
          for I := 0 to Count-1 do begin
            GetPOPMailListItem(I, Nb, Dt);
            if Dt in [0, 3] then begin
              SetStatusString(68, IntToStr(CIndex), IntToStr(CDown));
              if Aborted then Exit;
              Send(AddToLog(2, 'RETR '+IntToStr(Nb)));
              if Aborted then Exit;
              IsPOPOK(AddToLog(3, Receive));
              FFilename := sWinTempFolder+'pxrecv';
              if Aborted then Exit;
              AssignFile(F, FFilename);
              Rewrite(F);
              S1 := AddToLog(3, Receive);
              while  S1 <> '.' do begin
                if S1 = '..' then S1 := '.';
                WriteLn(F, S1);
                if Aborted then begin
                  CloseFile(F);
                  DeleteFile(S1);
                  Exit;
                end;
                S1 := AddToLog(3, Receive);
                SetCounter(Length(S1));
              end;
              try CloseFile(F); except end;
              SetCounter(-1);
              FDummy1 := I;
              Synchronize(FSavePOPNewMailToFolder);
              Inc(CIndex);
            end;
          end;
          // Delete mails
          CIndex := 1;
          for I := 0 to Count-1 do begin
            GetPOPMailListItem(I, Nb, Dt);
            if Dt in [0, 1] then begin
              SetStatusString(69, IntToStr(CIndex), IntToStr(CDel));
              FDummyBol := True;
              FDummy1 := I;
              if (Dt = 1) and (bAskForDelFromServer = True) then Synchronize(FAskToDeleteFromServer);
              if FDummyBol then begin
                if Aborted then Exit;
                Send(AddToLog(2, 'DELE '+IntToStr(Nb)));
                if Aborted then Exit;
                IsPOPOK(AddToLog(3, Receive));
              end;
              Inc(CIndex);
            end;
          end;
        end;
        SetStatusString(70, '', '');
        if Aborted then Exit;
        UsingProtPOP3 := False;
        Send(AddToLog(2, 'QUIT'));
        IsPOPOK(AddToLog(3, Receive));
        WinSocket.Close;
      end;

    end; //end while commandcount > 0
    UsingProtocol := False;
    if UsingProtocol then try CloseFile(FProtFile); except end;
  except
    on Error: Exception do begin Exception.Create(Error.Message); Exit; end;
  end;
  WinSocket.Free;
  Synchronize(FShowStatusMessage);
end;


Her gemmer jeg den mail der lige er blivet hentet


procedure TOnlineThread.FSavePOPNewMailToFolder;
var
  SL, PL: TStringList;
  FL: TList;
  AccountPath, FilterMsg, Result: String;
  I, E, K: Integer;
  Folder, Node: TTreeNode;
  Item: TListItem;
  EMail: TEMail;

  procedure GetSubNotes(Node: TTreeNode);
  var
    I, P: Integer;
  begin
    for I := 0 to Node.Count-1 do begin
      if PFolderData(Node.Item[I].Data)^.Inbox then begin
        ApplyFilter(FilterMsg, PFolderData(Node.Item[I].Data)^.Filter, P);
        if P >= 0 then begin
          SL.Add(PFolderData(Node.Item[I].Data)^.Path);
          PL.Add(IntToStr(P));
          FL.Add(Node.Item[I]);
        end;
      end;
      if Node.Count > 0 then GetSubNotes(Node.Item[I]);
    end;
  end;

begin
  Folder := nil;
  if DirectoryExists(AccPath) then begin
    Node := MainForm.GetActualAccount;
    for I := 0 to MainForm.TreeView1.Items.Count-1 do
      if MainForm.TreeView1.Items[I].StateIndex = 1 then
        if LowerCase(PAccountData(MainForm.TreeView1.Items[I].Data)^.Path) = LowerCase(AccPath) then
          Node := MainForm.TreeView1.Items[I];
    if Node = nil then Node := MainForm.RepositoryNode;
    FilterMsg := SelectMailForm.ListView1.Items[FDummy1].SubItems[5];
    SL := TStringList.Create;
    PL := TStringList.Create;
    FL := TList.Create;
    AccountPath := PAccountData(Node.Data)^.Path;
    GetSubNotes(Node);
    K := -1; E := 0;
    for I := 0 to PL.Count-1 do
      if StrToInt(PL.Strings[I]) >= E then begin
        E := StrToInt(PL.Strings[I]);
        K := I;
      end;
    if K = -1 then begin
      Result := AccountPath + GetUniqueMailName + '.msg';
      Folder := Node;
    end else begin
      Result := SL.Strings[K] + GetUniqueMailName + '.msg';
      Folder := FL[K];
    end;
    SL.Free; PL.Free; FL.Free;
  end else begin
    Result := sRepositoryFolder + GetUniqueMailName + '.msg';
  end;
  FileCopy(nil, FFilename, Result);
  SetFileAttr(Result, False, False, False, False);
  DeleteFile(FFilename);
  // add listview item
  if MainForm.TreeView1.Selected = Folder then begin
    EMail := TEMail.Create;
    EMail.ParseMail(Result, True);
    MainForm.ListView1.Items.BeginUpdate;
    Item := MainForm.ListView1.Items.Add;
    MainForm.ListView1.Items.EndUpdate;
    MainForm.ListView1.Invalidate;
    Application.ProcessMessages;
    Item.ImageIndex := -1;
    if FileGetAttr(Result) and faArchive = 0 then begin
      if (LowerCase(EMail.Priority) = 'low') then Item.ImageIndex := 9;
      if (LowerCase(EMail.Priority) = 'normal') then Item.ImageIndex := 10;
      if (LowerCase(EMail.Priority) = 'high') then Item.ImageIndex := 11;
    end;
    Item.SubItems.Add(EMail.Subject);
    Item.SubItems.Add(EMail.From);
    Item.SubItems.Add(DateToStr(EMail.ADate));
    Item.SubItems.Add(TimeToStr(EMail.ATime));
    Item.SubItems.Add(Result);
    EMail.Free;
  end;
  SetPXTreeNodeName(Folder);
  Inc(FetchedMailCount);
end;

håber du kan bruge det
Avatar billede zerohero Nybegynder
02. januar 2003 - 15:47 #16
dette vil tage lidt tid... så du bliver nødt til at være lidt tålmodig ;-))
Avatar billede sabine Nybegynder
02. januar 2003 - 15:50 #17
ok
Avatar billede hermandsen Juniormester
02. januar 2003 - 15:51 #18
Her er noget jeg en gang har lavet:

procedure WriteString(const S: String);
var
  Size: Word;
  P: PChar;
begin
  Size := Length(S);
  GetMem(P, Size+1);
  StrCopy(P, PChar(S));
  BlockWrite(F, Size, SizeOf(Word));
  BlockWrite(F, P^, Size);
  FreeMem(P);           
end;

function ReadString: String;
var
  Count: Word;
  Buf: array [1..300] of Char;
begin
  BlockRead(F, Count, SizeOf(Word));
  BlockRead(F, Buf, Count);
  Result := Copy(Buf, 0, Count);
end;


ReadString kunne nok godt laves bedre, men det finder du nok selv ud af! ;)

Hov ja forresten...

F-variablen er forresten bare en af type "file". De to procedure er bare under-procedure hvor i f var erklæret...

Når du så skal læse/skrive til en fil, så skal du kigge på AssignFile(f, Sti), Reset(f, 1) og Rewrite(f, 1).

Når du bruge Reset kan den anvendes på tre forskellige måder, read, write og read/write... Det sætter du med FileMode (kan slås op i hjælpen)...

fmOpenRead = 0
fmOpenWrite = 1
fmOpenReadWrite = 2

Default er 2.

//hermandsen
Avatar billede sabine Nybegynder
02. januar 2003 - 15:58 #19
når jeg parser min mail lægger jeg det over i en TEmail som er en Class Tobjekt den ser sådan her ud

type
  TMsgType = (mtText, mtHtml, mtRich);

  TEMail = class(TObject)
  private
  public
    ToReceiver, CC, BCC: TStringList;
    Fields, FieldValues: TStringList;
    Subject, Keywords, Priority, From, FileName: string;
    ADate, ATime: TDateTime;
    UseMime10: Boolean;
    ContentType, ContentEncoding: string;
    DispositionNotification, ReturnReceipt: string;
    MsgType: TMsgType;
    cntAttachments: integer; // AH06
    constructor Create;
    destructor Destroy; override;
    procedure GetMailHeader(var SL: TStringList);
    procedure ParseMail(AFilename: string; OnlyHeader: Boolean);
    procedure CompileMsgFileOnDisk(Filename: string);
    procedure Clear;
  end;

Jeg har set i nogke andre spg her på eksperten at man kan gemme objekter
men ved ikke om man kan gemme det her objekt i en fil og så hive dem ud igen det var bare et forslag
Avatar billede sabine Nybegynder
02. januar 2003 - 16:00 #20
F er erklæret som en global variable og af typen text
Avatar billede sabine Nybegynder
02. januar 2003 - 16:09 #21
hermandsen

din read og writestring kan den laves om til en record, det have været smart  at når jeg hentede mig mail at jeg så parset den med det samme og så gemte den i en fil, så når jeg henter den ind igen, kunne jeg så hente oplysningerne ud af recorden uden at skulle til at parse den igen, hvis du forstår hvad jeg mener
Avatar billede hermandsen Juniormester
02. januar 2003 - 16:19 #22
Du kan da bare parse den en gang, og så gemme de parsede dele i din fil...

Jeg bruger det til et download-program hvor jeg gemmer kilde, destination, størrelse og antal bytes hentet... Det virker skide godt. Eneste problem kan være at den henter hele indholdet ind i ram hver gang... Men det kan sådan set også ændres... Dog skal du vide at det tager en del tid at hente f.eks. 10.000 enheder ind i programmet (jeg har forsøgt).

Du får lige hele min SaveToFile-procedure! ;)

vFiles er et dynamisk array af en klasse jeg har lavet som har følgende variabler (som skal bruges i denne sammenhæng).

  vSource: String;
  vDest: String;
  vSize: Integer;
  vDownloaded: Integer;

procedure TFileList.SaveToFile(FileName: String);
var
  F: File;

  procedure WriteString(const S: String);
  var
    Size: Word;
    P: PChar;
  begin
    Size := Length(S);
    GetMem(P, Size+1);
    StrCopy(P, PChar(S));
    BlockWrite(F, Size, SizeOf(Word));
    BlockWrite(F, P^, Size);
    FreeMem(P);           
  end;

  procedure WriteInteger(Int: Integer);
  begin
    BlockWrite(F, Int, SizeOf(Integer));
  end;

var
  iCount, I: Integer;
begin
  try
    AssignFile(F, FileName);
    Rewrite(F, 1);
    iCount := 0;
    WriteInteger(iCount); //Skriver en integer i starten af filen der skal være plads til.
    for I := 0 to High(vFiles) do //Name, Source, Destination, Size, Downloaded
    begin
      if (vFiles[I].vID = -1) or (vFiles[I].vStatus = fsCompleted) then Continue;
      WriteString(vFiles[I].vSource);
      WriteString(vFiles[I].vDest);
      WriteInteger(vFiles[I].Size);
      WriteInteger(vFiles[I].Downloaded);
      Inc(iCount);
    end;
    Seek(F, 0);
    WriteInteger(iCount);
  finally
    CloseFile(F);
  end;
end;

//hermandsen
Avatar billede sabine Nybegynder
02. januar 2003 - 16:59 #23
ZeroHero og Jens er i faldet helt af

hermandsen jeg har ikke lige kikket på din savetofil, men hvordan se din Vfiles ud forresten hvad er det for at download program du har lavet det lyder spændene
Avatar billede zerohero Nybegynder
02. januar 2003 - 17:51 #24
function Hent(const FileName : string): String;
var
  F : file;// of TMinEgenFormat;
  Size : Word;
  P : PChar;
begin
  if FileExists(FileName) then
  begin
    AssignFile(F,FileName);
    Reset(F,1);
    try
      Size := FileSize(F);
      GetMem(P, Size+1);
      BlockRead(F, P^, Size);
      Result := Copy(P, 0, Size);
    finally
      FreeMem(P);
      CloseFile(F);
    end;
  end
  else
    ShowMessage('Filen eksitere ikke!');
end;

procedure Gem(const FileName, S: string);
var
  F : file;
  Size: Word;
  P : PChar;
  i : Integer;
  Str : string;
begin
  AssignFile(F,FileName);
  Rewrite(F,1);
  try
    Size := Length(S);
    GetMem(P, Size+1);
    StrCopy(P, PChar(S));
    BlockWrite(F, P^, Size);
  finally
    FreeMem(P);
    CloseFile(F);
  end;
end;
Avatar billede sabine Nybegynder
02. januar 2003 - 19:10 #25
Jeg takker for jeres indsats nu har jeg noget at arbejde med
Avatar billede hermandsen Juniormester
02. januar 2003 - 21:57 #26
Så er jeg tilbage...

Det "download" program jeg har lavet er egentlig bare noget til at kopiere filer fra et sted til et andet, uden at blive afbrudt. Jeg var enormt træt af at når jeg hentede filer fra vores lokale netværk på skolen, hvis der så var en gut der smed mig af. Hvis jeg så skulle hente videre, så måtte jeg starte forfra... Mit program starter bare derfra hvor du sidst blev smidt af, så nemt er det...

Programmet er egentlig ikke vildt svært at lave, og jeg har haft min unit til download af filer klar i lang tid, men det der generede mig mest var at få tingene lagt i thread og se løbende opdateringer i et TListView... Det er dog fikset nu! ;)

Lige nu er jeg lidt for doven til at få lavet på det, sikkert mest fordi det stort set er færdigt, men lægger da løbende en opdatering ud på hjemmesiden... Den er godt nok nede for tiden (server problemer), men det varer nok ikke længe før den står klar igen! ;)

//hermandsen
Avatar billede sabine Nybegynder
03. januar 2003 - 08:36 #27
jeg var lidt nysgerrig da jeg selv har prøvet at lave sådan et program
men jeg har problemer med at få server siden til at vise hvor meget den har sendt af en fil, jeg har prøvet at bruge indy's tcp komponent men har ikke kunne finde ud af hvor jeg skal sætte koden ind da jeg har brugt sendstreem som vist nok skulle være et thread.

men hermandsen jeg har brugt dit eksempel til at gemme med men når jeg henter det igen får jeg nogle gange nogen mærkelig tegn med jeg har gjort sådan her

procedure TForm1.SaveToFile(FileName: String);
var
  F: File;

  procedure WriteString(const S: String);
  var
    Size: LongWord;
    P: PChar;
  begin
    Size := Length(S);
    GetMem(P, Size+1);
    P^ := #0;
    StrCopy(P, PChar(S));
    BlockWrite(F, Size, SizeOf(LongWord));
    BlockWrite(F, P^, Size);
    FreeMem(P);
  end;

  procedure WriteInteger(Int: Integer);
  begin
    BlockWrite(F, Int, SizeOf(Integer));
  end;

var
  iCount, I: Integer;
begin
  try
    AssignFile(F, FileName);
    FileMode := 1;
    Rewrite(F, 1);
    iCount := 0;
    WriteInteger(iCount); //Skriver en integer i starten af filen der skal være plads til.
    for I := 0 to High(vFiles) do //Name, Source, Destination, Size, Downloaded
    begin
//      if (vFiles[I].vID = -1) or (vFiles[I].vStatus = fsCompleted) then Continue;
      WriteString (vFiles[I].vID);
      WriteString (vFiles[I].vDest);
      WriteInteger(vFiles[I].vSize);
      WriteInteger(vFiles[I].vDownloaded);
      Inc(iCount);
    end;
    Seek(F, 0);
    WriteInteger(iCount);
  finally
    CloseFile(F);
  end;
end;

procedure TForm1.GetFromFile(FileName: String);
var
  F: File;

  function ReadString: String;
  var
    Count: LongWord;
    P : PChar;
  begin
    Count := 0;
    BlockRead(F, Count, SizeOf(longWord));
    GetMem(P, count);
    P^ := #0;
    BlockRead(F, P^, Count);
    Result := StrPas(P);
    FreeMem(P);
  end;

  function ReadInteger : integer;
  begin
    Result := 0;
    BlockRead(F, Result, SizeOf(Integer));
  end;

var
  iCount, I: Integer;
begin
  try
  AssignFile(F, FileName);
  FileMode := 0;  {Set file access to read only }
  Reset(F,1);
  iCount := ReadInteger;
  for I := 0 to icount-1 do
    begin
    Memo1.Lines.Add(ReadString);
    Memo1.Lines.Add(ReadString);
    Memo1.Lines.Add(IntToStr(ReadInteger));
    Memo1.Lines.Add(IntToStr(ReadInteger));
    Memo1.Lines.Add('');
    end;
  finally
    CloseFile(F);
  end;

end;

er der noget jeg gør forkert
Avatar billede hermandsen Juniormester
03. januar 2003 - 14:05 #28
Jeg kan kun sige en ting!
Debug, debug, debug! Okay, det var så tre ting... ;)

Smid et breakpoint ind i ReadString og følg med i hvad der sker... Marker lidt efter lidt dine variabler, og tryk Ctrl+F7 for at vise indholdet af dem...

Jeg lod også være med at bruge PChar til ReadString, eftersom det hele tiden gav de underlige tegn som du snakker om... Et statisk array af Chars virker også udemærket, men det kan selvfølgelig blive træls at have 100.000 chars når man ikke en gang bruger halvdelen...

Jeg vil gerne hjælpe, men jeg har lige ominstalleret Windows, og min Delphi-cd er selvfølgelig blevet væk, så der går lige noget tid før jeg kan kigge ordentligt på koden, beklager...

Omkring det download-program jeg har lavet, så er der ikke så meget med en server side... Jeg bruger hverken Indy, eller nogen anden komponent til downloading af en fil... Det er bare en simpel AssignFile til en fil på et netværk...

AssignFile(F, '\\mig\mappe\fil.txt');
FileMode := 0;
Reset(F, 1);

Og så BlockRead/BlockWrite'er jeg ellers bare der ud af...

Måden jeg så følger med i hvor langt henne i filen jeg er kommet, er ved at have en tællevariabel der forøges med antallet af bytes der ligger i min buffer som BlockRead henter...

Hvis du vil vide mere omkring programmet kan du også finde mig på ICQ og MSN, så vi kan snakke nærmere! :)

//hermandsen
Avatar billede zerohero Nybegynder
03. januar 2003 - 14:55 #29
hermandsen>> Har du en løsning for at gemme en record med en dynamisk array?
Avatar billede hermandsen Juniormester
03. januar 2003 - 15:08 #30
Skal lige se om jeg har forstået det rigtigt:

type
  THest = record
    aInt: array of Integer;
    aStr: array of String;
  end;

Something like that?
Avatar billede zerohero Nybegynder
03. januar 2003 - 16:25 #31
Jamen det virker jo ikke når jeg bruger følgende kode...

procedure GemFil(FileName : string);
var
  W : THest;
  F : file of THest;
begin
  AssignFile(F,FileName);
  Rewrite(F);
  try
    Write(F, W);
  finally
    CloseFile(F);
  end;
end;

Har du et andet forslag... Når jeg nu så gerne vil gemme records (med dynamiske arrays) :-))
Avatar billede zerohero Nybegynder
03. januar 2003 - 17:10 #32
ok jeg har fundet ud af det men jeg forstår bare ikke, hvorfor DU bruger GetMem() det behøves slet ikke... i hvert fald ikke når jeg gør det. Godt Nyt År :-))
Avatar billede zerohero Nybegynder
03. januar 2003 - 18:04 #33
Hermandsen hvad gør jeg galt her?

type
  TMinEgenFormat = record
    S : string;
    I : Integer;
    A : array of Single;
    end;

function Hent(const FileName : string): TMinEgenFormat;
var
  F : file;
  P : TMinEgenFormat;
//  S : ^TMinEgenFormat;
begin
  if FileExists(FileName) then
  begin
    AssignFile(F,FileName);
    Reset(F,1);
    try
//      GetMem(P,FileSize(F));
      BlockRead(F, Result, FileSize(F));
//      Result := P^;
    finally
//      FreeMem(P,FileSize(F));
      CloseFile(F);
    end;
  end
  else
    ShowMessage('Filen eksitere ikke!');
end;

procedure Gem(const FileName : String; S: TMinEgenFormat);
var
  F : file;
  T : TMinEgenFormat;
  i : Integer;
begin
  //Copy TMinEgenFormat
  T.S := S.S;
  T.I := S.I;
  SetLength(T.A,S.I);
  for i := 0 to S.I-1 do
  T.A[i] := S.A[i];

  AssignFile(F,FileName);
  Rewrite(F,1);
  try
    BlockWrite(F, T, SizeOf(T));
  finally
    CloseFile(F);
  end;
end;


procedure TForm1.Button1Click(Sender: TObject);
var
  T : TMinEgenFormat;
  i : Integer;
begin
  T := Hent(Edit3.Text);
  Edit1.Text := (T.S);
  Edit2.Text := (IntToStr(T.I));
  ListBox1.Clear;
  for i := 0 to T.I-1 do
  ListBox1.Items.Add(FloatToStrF(T.A[i],ffFixed,5,1));
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  T : TMinEgenFormat;
begin
  T.S := Edit1.Text;
  T.I := StrToInt(Edit2.Text);
  SetLength(T.A,T.I);
  T.A[0] := 0.0;
  T.A[1] := 0.5;
  T.A[2] := 1.0;
  T.A[3] := 1.5;
  T.A[4] := 2.0;
  Gem(Edit3.Text,T);
end;
Avatar billede hermandsen Juniormester
03. januar 2003 - 18:43 #34
Så vidt jeg kan se, så gemmer du bare indholdet af det der er i din TMinEgenFormat. Problem:

type
  TMinEgenFormat = record
    S : string; //Det her er en pointer
    I : Integer;
    A : array of Single; //Et dyn-array er også en pointer
    end;

Løsning:

procedure Save(FileName: String; mef: TMinEgenFormat);
var
  F: File;
  I, aCount: Integer;

  procedure WriteString(const S: String);
  var
    Size: Word;
    P: PChar;
  begin
    Size := Length(S);
    GetMem(P, Size+1);
    StrCopy(P, PChar(S));
    BlockWrite(F, Size, SizeOf(Word));
    BlockWrite(F, P^, Size);
    FreeMem(P);         
  end;

begin
  try
    AssignFile(F, FileName);
    Rewrite(F, 1);
    WriteInteger(mef.S);
    BlockWrite(F, mef.I, SizeOf(Integer)); //Skriver Integer
    aCount := High(mef.A);
    BlockWrite(F, aCount, SizeOf(Integer));
    for I := Low(mef.A) to High(mef.A) do
      BlockWrite(F, mef.A[I], SizeOf(Single));
  finally
    CloseFile(F);
  end;
end;


function Load(FileName: String): TMinEgenFormat;
var
  F: File;
  I, aCount: Integer;

  function ReadString: String;
  var
    Count: Word;
    Buf: array [1..65536] of Char; //Dine strenge bliver forhåbentlig ikke længere
  begin
    BlockRead(F, Count, SizeOf(Word));
    BlockRead(F, Buf, Count);
    Result := Copy(Buf, 0, Count);
  end;

begin
  try
    AssignFile(F, FileName);
    FileMode := fmOpenRead; //konstanen er 0
    Reset(F, 1);
    Result.S := ReadString;
    BlockRead(F, Result.I, SizeOf(Integer));
    BlockRead(F, aCount, SizeOf(Integer));
    if aCount > -1 then
      SetLenght(Result.A, aCount + 1);
    for I := 0 to aCount do
      BlockRead(F, Result.A[I], SizeOf(Single));
  finally
    CloseFile(F);
  end;
end;

Noget i den retning... Har stadig ikke fundet min Delphi-cd! :(

Hov forresten, zerohero.. Gæt hvad jeg lige har bestilt:
Delphi Developer's Guide to OpenGL! Yeah!!! ;)

//hermandsen
Avatar billede zerohero Nybegynder
03. januar 2003 - 19:42 #35
10000 tak Hermandsen. Nu kan jeg komme videre med min Lib3D... Det glæder mig at høre at du vil anskaffe dig sådan en GULD bog. Det eneste jeg IKKE kan lide, ved fofatteren/bogen, er at han er stor tilhænger af Komponenter, men det skulle ikke være den den store hindring for en hærdet Delphi programmør som dig :-))

ZeroHero
(Får du problemer med bogen så skriv - Jeg har læst bogen til hudløshed *s*)
Avatar billede hermandsen Juniormester
03. januar 2003 - 19:48 #36
Hehe... Will do!
Den dumper ind med posten mellem d. 6. og d. 16., så der er jo ikke vandvittig lang tid til endnu! Glæder mig! :)
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Kurser inden for grundlæggende programmering

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester