Pascal source: UPGJKOMM.PAS

unit upgjkomm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    ComboBox1: TComboBox;
    Button1: TButton;
    Memo1: TMemo;
    ComboBox2: TComboBox;
    ComboBox3: TComboBox;
    ComboBox4: TComboBox;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ComboBox2Change(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
{$R *.DFM}
implementation
const
     PGJMAX = 1799;

type
    tpgj = array [1..PGJMAX] of integer;

var innfil,utfil:text;
    parfil:text;
    skille:shortstring;
    pgjliste:tpgj;
    linje:string;
    ordet:shortstring;
    kommnr,kode,indeks,lengde:integer;
    spos:byte;

Function getword(s:string;skille:char;lengde:integer;var ordet:shortstring;var spos:byte):boolean;
var i:byte;
begin
  while (s(.spos.)=' ') and (spos<=lengde) do
        spos:=succ(spos);
  i:=1;
  while (s(.spos.)<>skille) and (spos<=lengde) do begin
        ordet(.i.):=s(.spos.);
        i:=succ(i);
        spos:=succ(spos);
  end;
  if (spos>lengde) and (i=1) then
     getword:=false
  else begin
     i:=pred(i);
     ordet(.0.):=chr(i);
     getword:=true;
     spos:=succ(spos);
  end;
end;

Procedure  Lesparfil;
var feltnr:integer;
begin
  Form1.Memo1.Lines.Add('Les pgj-kommnr fil med skilleteikn: '+skille);
  while not eof(parfil) do begin
        readln(parfil,linje);
        lengde:=length(linje);
        spos:=1;
        ordet:='';
        feltnr:=1;
        while (getword(linje,skille[1],lengde,ordet,spos))
          and (feltnr<4)  do begin
              case feltnr of
              1: begin
                 val(ordet,indeks,kode);
                 if kode<>0 then begin
                      Form1.Memo1.Lines.Add('Feil på input: '+linje);
                    indeks:=0;
                 end;
                 end;
              3: begin
                 val(ordet,kommnr,kode);
                 if kode<>0 then
                    pgjliste[indeks]:=9999
                 else if indeks > 0 then
                    pgjliste[indeks]:=kommnr
                 else
                    Form1.Memo1.Lines.Add('Indeks manglar: '+linje);
                 end;
              end;
              feltnr:=succ(feltnr);
        end;
  end;
end;

Function Henttal(s:string):integer;
var tal,kode:integer;

begin
  tal:=0;
  repeat
    val(s,tal,kode);
    if kode<>0 then
       s:=copy(s,1,length(s)-1)
  until (s='') or (kode=0);
  if (s='') then
     henttal:=-1
  else
     henttal:=tal;
end;

Procedure LesSkriv;
var
    pgjnr:integer;
    linjenr:longint;
begin
  Form1.Memo1.Lines.Add('Les datafil: ');
  linjenr:=0;
  Form1.Memo1.Lines.Add(IntToStr(linjenr));
  while not eof(innfil) do begin
     readln(innfil,linje);
     linjenr:=succ(linjenr);
     pgjnr:=henttal(copy(linje,1,4));
     if pgjnr<0 then begin
        Form1.Memo1.Lines.Add('Feil på fil '+linje);
        pgjnr:=0;
     end;
     if (pgjnr>0) and (pgjnr<=PGJMAX) then begin
        if pgjliste[pgjnr]<1000 then write(utfil,'0');
        writeln(utfil,pgjliste[pgjnr],skille[1],linje);
     end
     else
        writeln(utfil,'9999',skille[1],linje);
     if (linjenr mod 300 = 0) then begin
        Form1.Memo1.Lines.Add(IntToStr(linjenr));
     end;
  end;
  Form1.Memo1.Lines.Add(IntToStr(linjenr));  
end;

Procedure Initkomm;
var i:integer;
begin
  for i:=1 to PGJMAX do
      pgjliste[i]:=9999
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  Initkomm;
  assignfile(innfil,combobox2.text);
  assignfile(parfil,combobox3.text);
  assignfile(utfil,combobox4.text);
  if combobox1.itemIndex<1 then
     skille:=chr(9)
  else
     skille:=combobox1.seltext[1];
  reset(parfil);
  Lesparfil;
  closefile(parfil);
  reset(innfil);
  rewrite(utfil);
  Lesskriv;
  closefile(innfil);
  closefile(utfil);
  button1.caption:='Ferdig';
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Combobox2.ItemIndex:=0;
  Combobox3.ItemIndex:=0;
  Combobox4.ItemIndex:=0;
end;

procedure TForm1.ComboBox2Change(Sender: TObject);
begin
  case combobox2.itemindex of
  1,3,5: combobox3.itemindex:=1;
  2,4,6,7: combobox3.itemindex:=0;
  end;
  combobox4.itemindex:=combobox2.itemindex;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
   Application.Terminate;
end;

end.