AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Win32/Win64 API (native code) Delphi CPU Auslastung für ein Programm begrenzen
Thema durchsuchen
Ansicht
Themen-Optionen

CPU Auslastung für ein Programm begrenzen

Ein Thema von Andidreas · begonnen am 18. Jul 2006 · letzter Beitrag vom 19. Jul 2006
 
xaromz

Registriert seit: 18. Mär 2005
1.682 Beiträge
 
Delphi 2006 Enterprise
 
#13

Re: CPU Auslastung für ein Programm begrenzen

  Alt 18. Jul 2006, 12:41
Hallo,

ich habe mir mal erlaubt, den Code etwas zu überarbeiten. Es gibt zwar sicher noch mehr zu optimieren, aber ich habe mich auf das Nötigste beschränkt. Erstens sind jetzt ein paar Ressourcen-Schutzblöcke mit 'drin, und zweitens hab ich von Textfile aud TStringlist umgestellt.
Schau' mal, ob das so schneller läuft.
Delphi-Quellcode:
procedure TMain_Form.prCreateXls(iAnzRec : Integer);
var
bl : Boolean;
oleExcelApp, oleExcelSheets, oleExcelWorkb : OleVariant;
i, j, iCount, iRow : Integer;
sDate, sFile, sPath, sRow, sXlsFile : String;
wRC : Word;
SL: TStringList;

begin

  //Paths
  sDate := FormatDateTime('yyyymmdd', Date);
  sFile := 'U:\Programmierung\LOG\Router_Tab\Excel\ROUTES_TAB_' + sDate;
  sPath := '..\Output\ROUTES_Convert_' + sDate + '.txt';

  //Create .xls / Set Column Format / Create Header

  try
    oleExcelApp := CreateOleObject('Excel.Application');
    oleExcelWorkb := oleExcelApp.Workbooks.Add;
    oleExcelSheets := oleExcelworkb.WorkSheets.Add;
    oleExcelSheets.Name := 'Router Tab vom ' + sDate;

    iRow := 1;
    For i := 1 To 7 Do
    Begin
      oleExcelSheets.Columns[i].NumberFormat := '@';
      oleExcelSheets.Cells[iRow, i].Font.FontStyle := 'Bold';
      case i of
        1: oleExcelSheets.Cells[iRow, i].Value := 'Land';
        2: oleExcelSheets.Cells[iRow, i].Value := 'PLZ Von';
        3: oleExcelSheets.Cells[iRow, i].Value := 'PLZ Bis';
        4: oleExcelSheets.Cells[iRow, i].Value := 'O - Sort';
        5: oleExcelSheets.Cells[iRow, i].Value := 'D - Depot';
        6: oleExcelSheets.Cells[iRow, i].Value := 'D - Sort';
        7: oleExcelSheets.Cells[iRow, i].Value := 'Barcode ID';
      end;
    End;


    iCount := 100;
    //Assign .txt File for Input
    SL := TStringList.Create;
    try
      try
        SL.LoadFromFile(sPath);

        iRow := 2;
        for j := 0 to SL.Count - 1 do
        begin
          For i := 1 To 7 Do
          Begin
            sRow := SL[j];
            case i of
              1: oleExcelSheets.Cells[iRow, i].Value := Copy(sRow, 1, 2);
              2: oleExcelSheets.Cells[iRow, i].Value := Copy(sRow, 3, 9);
              3: oleExcelSheets.Cells[iRow, i].Value := Copy(sRow, 12, 9);
              4: oleExcelSheets.Cells[iRow, i].Value := Copy(sRow, 21, 4);
              5: oleExcelSheets.Cells[iRow, i].Value := Copy(sRow, 25, 4);
              6: oleExcelSheets.Cells[iRow, i].Value := Copy(sRow, 29, 4);
              7: oleExcelSheets.Cells[iRow, i].Value := Copy(sRow, 33, 3);
            end;
          End;

          Inc(iRow);
          //Set Progress in Progress Bar
          If iRow = iCount Then
          Begin
            ProgBar2.Position := Round((100 * iRow) / iAnzRec);
            iCount := iCount + 100;
          End;
        end;
      except
        ShowMessage('Error opening file!');
      end;
    finally
      SL.Free;
    end;

    //Examine whether File is present
    bl := FileExists(sFile + '.xls');
    If bl = True Then
    Begin
      wRC := MessageDlg('File is allready present!' +#13+ 'Clear File?', mtInformation, mbYesNo, 0);
      If wRC = mrYes Then
      Begin
        bl := DeleteFile(sFile + '.xls');
        If bl = False Then
        Begin
          ShowMessage('Error with File Clear!');
        End;
      End
      Else
      Begin
        ShowMessage('File would be Overwritten!');
      End;
    End;



    //Save as .xls File
    sXlsFile := ChangeFileExt(sFile, '.xls');

    Try
      oleExcelWorkb.Close(true, sXlsFile, false);
    Except
      ShowMessage('Save To File Error');
    End;

    //Excel freigeben
  finally
    oleExcelSheets := Unassigned;
    oleExcelWorkb := Unassigned;
    oleExcelApp.Quit;
    oleExcelApp := Unassigned;
  end;

  ProgBar2.Position := 0;
  lbl_sts_xls.Caption := 'Export to Excel. OK';
  lbl_sts_xls.Font.Size := 8;
  lbl_sts_xls.Font.Color := clGreen;
  Main_Form.Refresh;

  bitbtn_exit.Enabled := True;
end;
Übrigens: Es sieht so aus, als würde diese Funktion mehrfach aufgerufen. Wenn ja, wie oft bzw. wie sieht der aufrufende Code aus?

Gruß
xaromz
  Mit Zitat antworten Zitat
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 18:36 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz