Demora en array (File of Arreglo)

[harimuya]

Estimados Srs.

Tengo un problema al ejecutar estas rutinas, demora mucho al generar el archivo, la informacion se recibe
de un Pic, el cual no demora casi nada, pero al ingresar a la rutina siguiente se toma mucho tiempo para generarlo,
alguien podriaindicarme como hacer para que al generar el archivo no demore tanto.

Gracias desde ya por su ayuda

Saludos.

Código Delphi [-]
Begin
    Destino:=Path+'c:\File.Epa';
    IniGra := 0;
    PosIniX:=IniIdx;
    AssignFile(Henry,Destino);

    Rewrite(Henry);
    DataGraf.Idx:=0;
    DataGraf.Nom:='Carlos';
    Write(Henry,DataGraf);

    {$I-}
    for LetIni:=1 to GetTokenCount(Memo1.Text, Caract) do
    begin
      wData:=GetToken(Memo1.Text, Caract, LetIni);

      if (wData <> CadenaSub) then
      begin
        if Length(wData) > 0 then
          VInt[IniGra] := StrToInt(wData)
      end
      else
      if (wData = CadenaSub) and (IniIdx > 1) then
      begin
        seek(Henry,IniIdx-1);
        DataGraf.Hora := wData;
        Write(Henry,DataGraf);
        IniGra  := 0;
        IniIdx  := IniIdx;
      end;

      if IniGra >= 4 then
      begin
        DataGraf.Nom   := '';
        DataGraf.Idx   := IniIdx;
        DataGraf.Line := VInt;
        DataGraf.Hora := '';
        Write(Henry,DataGraf);
        IniGra  := 0;
        IniIdx  := IniIdx+1;
      end;
      IniGra:=IniGra+1;
    end;
    {$I+}

    if IOResult = 0 then
      CloseFile(Henry)
    else
      ShowMessage('Hubo un Error.');
End;
/////////////////////////////
function GetToken(Cadena, Separador: String; Token: Integer): String;
var
  Posicion: Integer;
begin
  while Token > 1 do
  begin
    Delete(Cadena, 1, Pos(Separador,Cadena)+Length(Separador)-1);
    Dec(Token);
  end;
  Posicion:= Pos(Separador, Cadena);
  if Posicion = 0 then
    Result:= Cadena
  else
    Result:= Copy(Cadena, 1, Posicion-1);
end;
//////////////////////////////////
function GetTokenCount(Cadena, Separador: String): Integer;
var
  Posicion: Integer;
begin
  if Cadena <> '' then
  begin
    Posicion:= Pos(Separador, Cadena);
    Result:= 1;
    while Posicion <> 0 do
    begin
      Inc(Result);
      Delete(Cadena, 1, Posicion+Length(Separador)-1);
      Posicion:= Pos(Separador, Cadena);
    end;
  end
  else
    Result:=0;
end;