Source file: /~heha/hsn/kcemu/[Download]kcemu_050.exe/SRC/KCLOAD.PAS

program LOAD;
{$D KC-Load 0.41 (09/99)}
{$C MOVEABLE PRELOAD PERMANENT}
{$R KCLOAD.RES}

uses
  WinTypes, WinProcs, Win31, MMSystem, CommDlg{, ShellApi},
  WUtils;

const
 RegPath='KCEMU\KCLOAD';
 HelpFileName='KCLOAD.HLP';
 UserDllFilter='*.KCL';
 WaveFileName='KCLOAD.WAV';

var
 hWav: HWaveIn;		{fr Ein- und Ausgabe (erfolgt nie gleichzeitig)}
 Waves: array[0..1] of THandle;
 Modus: Integer;	{0=frei, 1=LOADing, 2=SAVEteimas}
{Gespeicherte Setup-Daten (Registry), MšSSEN HINTEREINANDER LIEGEN BLEIBEN}
 Retries: Integer;	{Anzahl Wiederholungen beim Lesen}
 Coding: Integer;	{Modus KC normal, Turbo MPM, Turbo h#s, Z1013}
 WaveVol: Integer;	{Lautst„rke-Multiplikator (log.) bei Ausgabe}
 WaveInDev, WaveOutDev: Integer;
			{Nummer des Ein- bzw. Ausgabeger„tes}
 Installed: Boolean;
 BytesToWrite: LongInt;
 BufPtr: LongInt;
 AppName: array[0..31] of Char;
 CurWaveHdr: PWaveHdr;	{ZeigerZeiger auf momentan zu prozessierende Daten}
 Task: THandle;
 LibInst: THandle;	{Geladene KCL-Bibliothek}
 Back: HBrush;		{Hintergrundpinsel fr Statuszeile (Blau)}

type
 TWaveFileHdr=record	{Header der WAVE-Datei}
  riff: array[0..3] of Char;
  rlen: LongInt;		{Offset 4, enth„lt filesize-8}
  wave,fmt: array[0..3] of Char;
  flen: LongInt;
  MyWav: TPCMWaveFormat;
  data: array[0..3] of Char;
  dlen: LongInt;		{Offset 28h, enth„lt filesize-2Ch}
 end;

const
 WAVBLK=$4000;		{je grӇer, desto weniger Aussetzer, aber asynchroner}
 WaveFileHdr: TWaveFileHdr=(
  riff: 'RIFF';
  rlen: -1;
  wave: 'WAVE';
  fmt : 'fmt ';
  flen: sizeof(TPCMWaveFormat);	{10h}
  MyWav:(
   wf:(
    wFormatTag:      WAVE_Format_PCM;
    nChannels:       1;
    nSamplesPerSec:  22050;
    nAvgBytesPerSec: 22050;
    nBlockAlign:     1);
   wBitsPerSample:   8);
  data: 'DATA';
  dlen: -1);

 WM_ContinueInit=WM_User+10;
 WM_EndProcess=WM_User+11;
 WM_SetStatus=WM_User+12;
 WM_ReportWaveError=WM_User+13;

type
 TBlock=array[0..127] of Byte;
 TCallProc=procedure;	{Formatabh„ngige Lese/Schreibfunktion}
 TS255=array[0..255] of Char;
 TS31=array[0..31] of Char;

var
 MainWnd: HWnd;		{Global ist besser im Zugriff!}
 hBuffer: THandle;	{Speicherabbild der Datei, Wachstum durch Verdopplung}
{ S: array[byte]of Char;}
 ByteIndex: Word;
 Amp: ShortInt;

procedure EndProcess1(OK:Boolean); forward;
function SaveFile:Boolean; forward;
procedure FreeWaveBlock(var M:THandle); forward;
function GetFileName(S,buf:PChar):integer; forward;

procedure SetStat(S:PChar);
 begin
  PostMessage(MainWnd,WM_SetStatus,0,LongInt(S));
 end;

function GetSize:LongInt;
 begin
  case Modus of
   1: GetSize:=BufPtr;
   2: GetSize:=BytesToWrite-BufPtr;
  end;
 end;

function GetData(P:PChar; Size:Integer):Integer;
 var
  Buf: PChar;
 begin
  Buf:=GlobalLock(hBuffer);
  IncHPL(Buf,BufPtr);
  if Size>BytesToWrite-BufPtr then Size:=BytesToWrite-BufPtr;
  hmemcpy(P,Buf,Size);
  Inc(BufPtr,Size);
  GetData:=Size;
  GlobalUnlock(hBuffer);
 end;

procedure AddData(P:PChar; Size:Integer);
 var
  Buf: PChar;
 begin
  if BufPtr+Size>GlobalSize(hBuffer) then begin
   hBuffer:=GlobalReAlloc(hBuffer,GlobalSize(hBuffer) shl 1,0);
   if hBuffer=0 then EndProcess1(false);	{sollte nie passieren}
  end;
  Buf:=GlobalLock(hBuffer);
  IncHPL(Buf,BufPtr);
  hmemcpy(Buf,P,Size);
  Inc(BufPtr,Size);
  GlobalUnlock(hBuffer);
 end;

procedure ProcessBlock;
{Kontext: MMTASK.TSK}
 var
  Msg: TMsg;
 begin
  with CurWaveHdr^ do case Modus of
   1: begin
    if WaveInDev=-2 then begin
     LongRec(dwBytesRecorded).Lo:=
       _lread(hWav,lpData,LongRec(dwBufferLength).Lo);
     if LongRec(dwBytesRecorded).Lo=0 then EndProcess1(false);
     PeekMessage(Msg,0,0,0,PM_Remove);	{Windows zum Zug kommen lassen}
     if Msg.message=WM_Quit then EndProcess1(false);
    end else begin
     WaveInAddBuffer(hWav,CurWaveHdr,sizeof(TWaveHdr));	{leeren Puffer hinein}
     if not GetMessage(Msg,0,0,0) then EndProcess1(false);
					{gibt Rechenzeit frei}
{$IFOPT D+} if Msg.message<>MM_WIM_Data then asm int 3 end; {$ENDIF}
     CurWaveHdr:=Pointer(Msg.lParam);	{Neuer Block, gefllt mit Daten, steht bereit}
    end;
    ByteIndex:=0;	{Lesezeiger}
   end;
   2: begin
    if WaveOutDev=-2 then begin
     if _lwrite(hWav,CurWaveHdr^.lpData,
       LongRec(CurWaveHdr^.dwBufferLength).Lo)<>
       LongRec(CurWaveHdr^.dwBufferLength).Lo
     then EndProcess1(false);
     PeekMessage(Msg,0,0,0,PM_Remove);	{Windows zum Zug kommen lassen}
     if Msg.message=WM_Quit then EndProcess1(false);
    end else begin
     WaveOutWrite(hWav,CurWaveHdr,sizeof(TWaveHdr));	{vollen Puffer hinein}
     if not GetMessage(Msg,0,0,0) then EndProcess1(false);
					{gibt Rechenzeit frei}
{$IFOPT D+} if Msg.message<>MM_WOM_Done then asm int 3 end; {$ENDIF}
     CurWaveHdr:=Pointer(Msg.lParam);	{Geleerter Puffer}
    end;
    ByteIndex:=0;	{Schreibzeiger}
   end;
  end;
 end;

procedure EndProcess1(OK:Boolean);
{Kontext: MMTASK.TSK, Funktion beendet Task}
 var
  os: TOfStruct;
  FPos: LongInt absolute os;
 begin
  case Modus of
   1: begin
    if WaveInDev<>-2 then begin
     WaveInReset(hWav);	{Restliche (leere) Puffer "ausspucken"}
     WaveInClose(hWav);	{Ger„t schlieáen}
    end else _lclose(hWav);
   end;
   2: begin
    if WaveOutDev<>-2 then begin
     if OK then begin
      if ByteIndex<>0 then begin
       LongRec(CurWaveHdr^.dwBufferLength).Lo:=ByteIndex;
       ProcessBlock;
      end;
      while WaveOutClose(hWav)<>0	{=WAVERR_StillPlaying}
      do MMTaskBlock(Task);
     end else begin
      WaveOutReset(hWav);	{im Abbruch-Fall}
     end;
     WaveOutClose(hWav);
    end else begin
     if OK then begin		{WAV-Datei patchen}
      FPos:=_llseek(hWav,0,1);	{Momentanposition}
      Dec(FPos,8);
      _llseek(hWav,4,0);
      _lwrite(hWav,PChar(@FPos),4);
      Dec(FPos,$2C-8);
      _llseek(hWav,$28,0);
      _lwrite(hWav,PChar(@FPos),4);
     end;
     _lclose(hWav);
     if not OK then OpenFile(WaveFileName,os,OF_Delete);
    end;
   end;
  end{case};
  FreeWaveBlock(Waves[0]);
  if WaveInDev<>-2 then FreeWaveBlock(Waves[1]);
  PostMessage(MainWnd,WM_EndProcess,Word(OK),0);
  halt;
 end;

function MakeWaveBlock(var M:THandle):PWaveHdr;
{benutzt globale Variablen hWav und Modus}
 var
  WH: PWaveHdr;
 begin
  M:=GlobalAlloc(GHND or GMEM_Share,sizeof(TWaveHdr)+WAVBLK);
  WH:=GlobalLock(M);
  WH^.lpData:=PChar(WH)+sizeof(TWaveHdr);
  WH^.dwBufferLength:=WAVBLK;
  if Modus=1
  then WaveInPrepareHeader(hWav,WH,sizeof(TWaveHdr))
  else WaveOutPrepareHeader(hWav,WH,sizeof(TWaveHdr));
  MakeWaveBlock:=WH;
 end;

procedure FreeWaveBlock(var M:THandle);
{benutzt globale Variablen hWav und Modus}
 var
  WH: PWaveHdr;
 begin
  GlobalUnlock(M);	{der Block war die ganze Zeit gelockt!}
  WH:=GlobalLock(M);	{Pointer beschaffen}
  if Modus=1
  then WaveInUnprepareHeader(hWav,WH,sizeof(TWaveHdr))
  else WaveOutUnprepareHeader(hWav,WH,sizeof(TWaveHdr));
  GlobalUnlock(M);
  M:=GlobalFree(M);
 end;

function memcmpw(var p1, p2; vlen: Word):Boolean; assembler;
 asm	push	ds
	lds	si,[p2]
	les	di,[p1]
	mov	cx,vlen
	mov	al,FALSE
	cld
	rep	cmpsb	{[SI]-[DI]}
	pop	ds
	jnz	@@e
	inc	al	{TRUE}
@@e:
 end;

procedure WaveInTask(CallProc:TCallProc);far;
{Kontext: MMTASK.TSK, Funktion beendet Task und kehrt nicht zurck}
 var
  I: Integer;
  ThisWaveFileHdr: TWaveFileHdr;
 begin
  asm mov ax,seg @data; mov ds,ax; {$IFOPT D+} int 3 {$ENDIF} end;
  if WaveInDev=-2 then begin
   I:=mmsyserr_InvalHandle;	{5}
   hWav:=_lopen(WaveFileName,0);
   if (_lread(hWav,PChar(@ThisWaveFileHdr),sizeof(TWaveFileHdr))
     =sizeof(TWaveFileHdr))
   then begin
    I:=mmsyserr_NotSupported;	{8}
    if memcmpw(ThisWaveFileHdr.riff,WaveFileHdr.riff,2)
    and memcmpw(ThisWaveFileHdr.wave,WaveFileHdr.wave,$10)
    then I:=0
    else _lclose(hWav);
   end else _lclose(hWav);
  end else begin
   I:=Integer(WaveInOpen(@hWav,Word(WaveInDev),@WaveFileHdr.MyWav.wf,
     MMGetCurrentTask,0,Callback_Task));
   if I<>0 then begin
    PostMessage(MainWnd,WM_ReportWaveError,I,0);
    halt;
   end;
   MMTaskBlock(Task);		{MM_WIM_Open entfernen}
   WaveInAddbuffer(hWav,MakeWaveBlock(Waves[0]),sizeof(TWaveHdr));
   CurWaveHdr:=MakeWaveBlock(Waves[1]);
   ByteIndex:=$FFFF;
   WaveInStart(hWav);
  end;
  CallProc;
  EndProcess1(true);
 end;

procedure WaveOutTask(CallProc:TCallProc);far;
{Kontext: MMTASK.TSK, Funktion beendet Task und kehrt nicht zurck}
 var
  I: Integer;
 begin
  asm mov ax,seg @data; mov ds,ax; {$IFOPT D+} int 3 {$ENDIF}  end;
  if WaveOutDev=-2 then begin
   I:=mmsyserr_InvalHandle;		{5}
   hWav:=_lcreat(WaveFileName,0);
   if hWav<>-1 then begin
    if _lwrite(hWav,PChar(@WaveFileHdr),sizeof(WaveFileHdr))
      =sizeof(WaveFileHdr)
    then I:=0				{mmsyserr_NoError}
    else _lclose(hWav);
   end;
  end else I:=Integer(WaveOutOpen(@hWav,Word(WaveOutDev),@WaveFileHdr.MyWav.wf,
     MMGetCurrentTask,0,Callback_Task));
  if I<>0 then begin
   PostMessage(MainWnd,WM_ReportWaveError,I,0);
   halt;
  end;
  if WaveOutDev<>-2 then begin
   MMTaskBlock(Task);		{MM_WOM_Open entfernen}
   CurWaveHdr:=MakeWaveBlock(Waves[0]);
   PostAppMessage(MMGetCurrentTask,MM_WOM_Done,hWav,
     LongInt(MakeWaveBlock(Waves[1])));
  end;
  ByteIndex:=0;
  CallProc;
  EndProcess1(true);
 end;

{-Laden-von-Kassette---------------------------------------------------------}
function ReadB:ShortInt;
{Kontext: MMTASK.TSK}
 begin
  with CurWaveHdr^ do begin
   if ByteIndex>=LongRec(dwBytesRecorded).Lo
   then ProcessBlock;		{N„chsten Block einlesen}
  end;				{CurWaveHdr ge„ndert, WITH beenden!!!}
  with CurWaveHdr^ do begin
   ReadB:=Integer(lpData[ByteIndex])-$80;
   Inc(ByteIndex);
  end;
 end;

function ReadSwing1:Integer;
{Kontext: MMTASK.TSK}
 var
  W: Integer;
 begin
  W:=1;
  if ReadB<0
  then repeat Inc(W) until ReadB>0
  else repeat Inc(W) until ReadB<0;
  ReadSwing1:=W;
 end;

function ReadSwing2: Integer;
{Kontext: MMTASK.TSK}
 begin
  ReadSwing2:=ReadSwing1+ReadSwing1;
 end;

{*************************************}
{*** Formatabh„ngige Lese-Routinen ***}
{*************************************}

procedure ReadDataKCC; far;
{Kontext: MMTASK.TSK}

  function KCBytein:Byte;
   var
    I,W:Integer;
    B:Byte;
  begin
   for I:=0 to 7 do begin
    w:=ReadSwing2;
    B:=B SHR 1;
    if w>16 then B:=B or $80;
   end;
   ReadSwing2;
   KCBytein:=B;
  end;

  function ReadBlock(var BlkNr:Byte; var Buffer:TBlock):Boolean;
   var
    I,W:Integer;
    B,Sum:Byte;
   begin
    ReadBlock:=false;
  {Schritt 1: Vorton erkennen und aufsynchronisieren}
    for I:=1 to 22 do begin
     W:=ReadSwing2;
     if (W<18) or (W>30) then begin
      I:=0;
      continue;
     end;
    end;
  {Schritt 2: 1. Trennzeichen holen}
    for I:=1 to 2 do begin
     W:=ReadSwing1;
     if (W<15) then begin
      I:=0;
      continue;
     end;
    end;
  {Schritt 3: Bytes lesen}
    BLKNr:=KCByteIn;
    Sum:=0;
    for I:=0 to 127 do begin
     B:=KCByteIn;
     Inc(Sum,b);
     Buffer[I]:=b;
    end;
    If Sum=KCByteIn then ReadBlock:=true;
   end;

 var
  ExpectBlock: Byte;
  FirstBlock: Boolean;
  BlkNr:Byte;
  L:LongInt;
  ok: Boolean;
  S: TS31;
  X,I,J: Integer;		{Index fr Blocknummer-OK und Blocknummer-Aktuell}
  buf: TBlock;
  SP2: PChar;
  vsrec: record
   bn: Integer;
   ch: Char;
  end;
  w: Word;
 begin
  L:=$7FFFFFFF;
  FirstBlock:=true;
  for I:=300 downto 0 do begin
   W:=ReadSwing2;
   if (W<18) or (W>30) then I:=200;
  end;
  I:=wvsprintf(S,'LOAD ',I);
  SetStat(S);
  repeat
   ok:=ReadBlock(BlkNr,buf);
   vsrec.bn:=BlkNr;
   if Firstblock then ExpectBlock:=BlkNr;
   if OK then begin
    if (BlkNr=ExpectBlock) or ((BlkNr=$FF) and not FirstBlock) then begin
     vsrec.ch:='>';
     J:=0;
     AddData(PChar(@Buf),sizeof(buf));
     if (BlkNr=$FF) and (ExpectBlock<>$FF) then exit;
     if FirstBlock then begin
      if buf[0]=$D3 then L:=buf[11]+buf[12]*256+14;
      SP2:=PChar(@buf);
      I:=GetFileName(S,SP2);
      FirstBlock:=false;
     end;
     Inc(ExpectBlock);
    end else begin
     vsrec.ch:='*';
     J:=4;
    end;
   end else begin
    vsrec.ch:='?';
    J:=4;
   end;
   wvsprintf(S+I+J,' %02X%c',vsrec);
   SetStat(S);
  until GetSize>L;
 end;

procedure ReadDataMPMTurbo; far;
{Kontext: MMTASK.TSK}

  function KCBytein:Byte;
   var
    I,W:Integer;
    B:Byte;
  begin
   for I:=0 to 7 do begin
    w:=ReadSwing1;
    B:=B SHR 1;
    if w>=10 then B:=B or $80;
   end;
   KCBytein:=B;
  end;

  function ReadBlock(var BlkNr:Byte; var Buffer:TBlock):Boolean;
   label Try;
   var
    I,W:Integer;
    B,Sum:Byte;
   begin
    ReadBlock:=false;
  {Schritt 1: Vorton erkennen und aufsynchronisieren}
Try:
    for I:=1 to 40 do begin
     W:=ReadSwing1;
     if W>=10 then begin
      I:=0;
      continue;
     end;
    end;
  {Schritt 2: 1. Trennzeichen holen}
    for I:=1 to 2 do begin
     W:=ReadSwing1;
     if W<10 then begin
      if I=2 then Goto Try else I:=0;
      continue;
     end;
    end;
  {Schritt 3: Bytes lesen}
    BLKNr:=KCByteIn;
    Sum:=0;
    for I:=0 to 127 do begin
     B:=KCByteIn;
     Inc(Sum,B);
     Buffer[I]:=B;
    end;
    If Sum=KCByteIn then ReadBlock:=true;
   end;

 var
  ExpectBlock: Byte;
  FirstBlock: Boolean;
  L:LongInt;
  BlkNr:Byte;
  ok: Boolean;
  S: array[0..31] of Char;
  I,J: Integer;		{Index fr Blocknummer-OK und Blocknummer-Aktuell}
  buf: TBlock;
  SP2: PChar;
  vsrec: record
   bn: Integer;
   ch: Char;
  end;
 begin
  L:=$7FFFFFFF;
  FirstBlock:=true;
  ExpectBlock:=1;
  I:=wvsprintf(S,'TLOAD ',I);
  SetStat(S);
  repeat
   ok:=ReadBlock(BlkNr,buf);
   vsrec.bn:=BlkNr;
   if OK then begin
    if (BlkNr=ExpectBlock) or ((BlkNr=$FF) and not FirstBlock) then begin
     vsrec.ch:='>';
     J:=0;
     AddData(PChar(@Buf),sizeof(buf));
     if (BlkNr=$FF) and (ExpectBlock<>$FF) then exit;
     if FirstBlock then begin
      if buf[0]=$D3 then L:=buf[11]+buf[12]*256+14;
      SP2:=PChar(@buf);
      I:=GetFileName(S,SP2);
      FirstBlock:=false;
     end;
     Inc(ExpectBlock);
    end else begin
     vsrec.ch:='*';
     J:=4;
    end;
   end else begin
    vsrec.ch:='?';
    J:=4;
   end;
   wvsprintf(S+I+J,' %02X%c',vsrec);
   SetStat(S);
  until GetSize>L;
 end;

procedure ReadDataHSTurbo; far;
{Kontext: MMTASK.TSK}
 var
  S: array[0..31] of Char;
  I,W: integer;
  Sum,B:Byte;
 begin
  ReadDataKCC;
  SetStat(lstrcpy(S,'H#S TURBO'));
  for I:=0 to 40 do begin
   W:=ReadSwing1;
   if W<12 then begin I:=0;continue;end;
  end;
  repeat
  until ReadSwing1<12;
  Sum:=0;
  Repeat
   for I:=0 to 7 do begin
    w:=ReadSwing1;
    B:=B SHL 1;
    if w>20 then begin AddData(PChar(@Sum),1);exit;end;
    if w>6 then B:=B or 1;
   end;
   inc(Sum,B);
   AddData(PChar(@B),1);
  until false
 end;

procedure ReadDataZ1013; far;
{Kontext: MMTASK.TSK}

 type
  TBlk=array[0..15] of Word;

  function Wordin:Word;
   var
    I:Integer;
    W:Word;
  begin
   for I:=0 to 15 do begin
    W:=W SHR 1;
    if ReadSwing1>6 then W:=W or $8000 else ReadSwing1;
   end;
   Wordin:=W;
  end;

  function ReadBlock(var Buffer:TBlk):Boolean;
   var
    I:Integer;
    W,Sum:Word;
   begin
    ReadBlock:=false;
  {Schritt 2: 1. Trennzeichen holen}
    for I:=1 to 2 do begin
     W:=ReadSwing1;
     if W>15 then begin
      I:=0;
      continue;
     end;
    end;
  {Schritt 3: Bytes lesen}
    Wordin;
    Sum:=0;
    for I:=0 to 15 do begin
     W:=WordIn;
     Inc(Sum,W);
     Buffer[I]:=W;
    end;
    {If Sum=WordIn then} ReadBlock:=true;
   end;

 var
  ok: Boolean;
  S: array[0..31] of Char;
  I,J: Integer;		{Index fr Blocknummer-OK und Blocknummer-Aktuell}
  buf: TBlk;
 begin
  SetStat(lstrcpy(S,'Z1013LOAD '));
  repeat
   ok:=ReadBlock(buf);
   if OK then begin
    AddData(PChar(@Buf),sizeof(buf));
    SetStat(lstrcpy(S,'>'));
   end else begin
    SetStat(lstrcpy(S,'?'));
   end;
  until Readswing2<100;
 end;

procedure ReadDataBasicode; far;
{Kontext: MMTASK.TSK}
 var
  S: array[0..31] of Char;
  I: Integer;
  B,Sum:Byte;

 function Bytein:Byte;
  var
   I,W:Integer;
   B:Byte;
  begin
   for I:=1 to 2 do begin
    W:=ReadSwing1;
    if W<7 then begin
     I:=0;
     continue;
    end;
   end;
   for I:=0 to 7 do begin
    w:=ReadSwing2;
    B:=B SHR 1;
    if w<16 then begin B:=B or $80;ReadSwing2;end;
   end;
   Sum:=Sum xor B;
   Bytein:=B xor $80;
  end;

 var
  w: Word;

 begin
  SetStat(lstrcpy(S,'BASICODE '));
  for I:=1 to 40 do begin
   W:=ReadSwing1;
   if W>=6 then begin
    I:=0;
    continue;
   end;
  end;
  SetStat(lstrcat(S,'2400Hz'));
  Sum:=$0;
  If ByteIn=1 then ByteIn;
  Repeat
   B:=ByteIn;
   If B=3 then begin
    B:=Sum;
    If ByteIn<>B then SetStat(lstrcpy(S,'Lesefehler erkannt!'));
    ShortYield;
    exit;
   end;
   AddData(PChar(@B),1);
   if B=$0D then B:=0;
   B:=B and $7F;
   if B in [1..$1F,$7F] then B:=Byte('.');
   S[I]:=Char(B);
   if I<sizeof(S)-1 then Inc(I);
   if B=0 then begin
    SetStat(S);
    I:=0;
   end;
  until false;
 end;

{-Speichern-auf-Kassette-----------------------------------------------------}
procedure WriteB;
{Kontext: MMTASK.TSK}
 begin
  with CurWaveHdr^ do begin
   lpData[ByteIndex]:=Char(Integer(Amp)+$80);
   Inc(ByteIndex);
   if ByteIndex>=LongRec(dwBufferLength).Lo
   then begin
    asm int 3 end;
    ProcessBlock;		{vollen Block schreiben}
   end;
  end;
 end;

procedure WriteSwing1(Len:Integer);
{Kontext: MMTASK.TSK}
 begin
  for Len:=Len downto 1 do begin
   WriteB;
  end;
  Amp:=-Amp;
 end;

procedure WriteSwing2(Len:Integer);
{Kontext: MMTASK.TSK}
 var
  Len1:integer;
 begin
  Len1:=Len div 2;
  WriteSwing1(Len1);
  WriteSwing1(Len-Len1)
 end;

procedure WriteDataKCC; far;
{Kontext: MMTASK.TSK}
{Schreibt BytesToWrite Bytes aus dem hBuffer}

  procedure WriteByte(B:Byte);
   var
    I,W:Integer;
   begin
    for I:=0 to 7 do begin
     W:=12;
     if B and 1 <>0 then W:=22;
     WriteSwing2(W);
     B:=B shr 1;
    end;
    WriteSwing2(38);
   end;

  procedure WriteBlock(BlkNr:Byte; const Buffer:TBlock; Vorton:Integer);
   var
    I,W:Integer;
    B,Sum:Byte;
   begin
    for I:=1 to Vorton do WriteSwing2(22);	{Vorton}
    WriteSwing2(38);				{Trennzeichen}
    WriteByte(BlkNr);
    Sum:=0;
    for I:=0 to $7F do begin
     Inc(Sum,Buffer[I]);
     WriteByte(Buffer[I]);
    end;
    WriteByte(Sum);
   end;

 var
  CurBlk: Byte;
  S: array[0..31] of Char;
  I: Integer;
  buf: TBlock;
  Erster_Block, Letzter_Block: Boolean;
 begin
  CurBlk:=1;
  Erster_Block:=true;
  Letzter_Block:=false;
  repeat
   I:=GetData(PChar(@buf),sizeof(buf));
   if ((I<sizeof(buf)) or (GetSize=0))
   and (not Erster_Block)
   and (CurBlk<>$FF) then begin
    Letzter_Block:=true;
    CurBlk:=$FF;
   end;
   I:=$A0;
   if Erster_Block then I:=$A00;
   WriteBlock(CurBlk,buf,I);
   I:=CurBlk;
   Inc(CurBlk);
   wvsprintf(S,'%02X<',I);
   SetStat(S);
   Erster_Block:=false;
  until Letzter_Block;
 end;

procedure WriteDataMPMTurbo; far;
{Kontext: MMTASK.TSK}
{Schreibt BytesToWrite Bytes aus dem hBuffer}

  procedure WriteByte(B:Byte);
   var
    I,W:Integer;
   begin
    for I:=0 to 7 do begin
     W:=5;
     if B and 1 <>0 then W:=9;
     WriteSwing1(W);
     B:=B shr 1;
    end;
   end;

  procedure WriteBlock(BlkNr:Byte; const Buffer:TBlock; Vorton:Integer);
   var
    I,W:Integer;
    B,Sum:Byte;
   begin
    for I:=1 to Vorton do WriteSwing2(9);	{Vorton}
    WriteSwing2(24);				{Trennzeichen}
    WriteByte(BlkNr);
    Sum:=0;
    for I:=0 to $7F do begin
     Sum:=Sum xor Buffer[I];
     WriteByte(Buffer[I]);
    end;
    WriteByte(Sum);
   end;

 var
  CurBlk: Byte;
  S: array[0..31] of Char;
  I: Integer;
  buf: TBlock;
  Erster_Block, Letzter_Block: Boolean;
 begin
  CurBlk:=1;
  Erster_Block:=true;
  Letzter_Block:=false;
  repeat
   I:=GetData(PChar(@buf),sizeof(buf));
   if ((I<sizeof(buf)) or (GetSize=0))
   and (not Erster_Block)
   and (CurBlk<>$FF) then begin
    Letzter_Block:=true;
    CurBlk:=$FF;
   end;
   I:=$70;
   if Erster_Block then I:=$1000;
   WriteBlock(CurBlk,buf,I);
   I:=CurBlk;
   Inc(CurBlk);
   wvsprintf(S,'%02X<',I);
   SetStat(S);
   Erster_Block:=false;
  until Letzter_Block;
 end;

procedure WriteDataHSTurbo; far;
{Kontext: MMTASK.TSK}
{Schreibt BytesToWrite Bytes aus dem hBuffer}
 var
  BTW: Longint;
  I,J,W:Integer;
  B:Byte;
  S: TS255;
 begin
  {Loader saven}
  BTW:=BytestoWrite;BytestoWrite:=256;
  WriteDataKCC;
  BytestoWrite:=BTW;
  {eigentliche Daten speichern}
  SetStat(lstrcpy(S,'H#S TURBO'));
  for I:=0 to 512 do WriteSwing2(30);
  WriteSwing1(9);
  while GetData(PChar(@B),1)<>0 do begin
   for I:=0 to 7 do begin
    W:=5;
    if B and 1 <>0 then W:=9;
    WriteSwing1(W);
    B:=B shr 1;
   end;
  end;
 end;

procedure WriteDataZ1013; far;
{Kontext: MMTASK.TSK}
{Schreibt BytesToWrite Bytes aus dem hBuffer}
 type
  TBlk=array[0..15] of Word;
 var
  S: array[0..31] of Char;
  I:integer;
  buf:TBlk;

  procedure WriteWord(W:Word);
   var
    I:Integer;
   begin
    wvsprintf(S,'%04X',W);Setstat(s);
    for I:=0 to 15 do begin
     if W and 1 <>0 then WriteSwing1(9) else WriteSwing2(9);
     W:=W shr 1;
    end;
   end;

  procedure WriteBlock(const Buffer:TBlk; Vorton:Integer);
   var
    I:Integer;
    Sum:Word;
   begin
    for I:=1 to Vorton do WriteSwing1(17);	{Vorton}
    WriteSwing2(16);				{Trennzeichen}
    WriteWord(0);
    Sum:=0;
    for I:=0 to 15 do begin
     inc(Sum,Buffer[I]);
     WriteWord(Buffer[I]);
    end;
    WriteWord(Sum);
   end;

 begin
  I:=2000;
  SetStat(lstrcpy(S,'Z1013 Save'));
  While GetSize>0 do begin
   GetData(PChar(@buf),sizeof(buf));
   WriteBlock(buf,I);
   I:=14;
  end;
 end;


procedure WriteDataBasicode; far;
{Kontext: MMTASK.TSK}
{Schreibt BytesToWrite Bytes aus dem hBuffer}
 var
  S: array[0..31] of Char;
  I: Integer;
  B,Sum:Byte;

  procedure WriteByte(B:Byte);
   var
    I,W:Integer;
   begin
    Sum:=Sum xor B;
    WriteSwing2(18);
    for I:=0 to 7 do begin
     if B and 1 =0 then WriteSwing2(18)
     else begin WriteSwing2(9);WriteSwing2(9);end;
     B:=B shr 1;
    end;
    WriteSwing2(9);WriteSwing2(9);
   end;

 begin
  Sum:=0;
  for I:=1 to 9000 do WriteSwing2(9);
  WriteByte(2);
  I:=0;
  while GetData(PChar(@B),1)<>0 do begin
   WriteByte(B);
   if B=$0D then B:=0;
   B:=B and $7F;
   if B in [1..$1F,$7F] then B:=Byte('.');
   S[I]:=Char(B);
   if I<sizeof(S)-1 then Inc(I);
   if B=0 then begin
    SetStat(S);
    I:=0;
   end;
  end;
  WriteByte(3);
  WriteByte(Sum xor $80);
  for I:=1 to 3500 do WriteSwing2(9);
 end;

{-Dialogfunktionen-----------------------------------------------------------}
const
 ID_OfnWriteProt=1040;
function OFNHook(Wnd:HWnd; Msg,wParam:Word; lParam:Longint):Word; export;
 {tr„gt lediglich 'mit Vorblock' ein;
  sollt bei SAVE aber erkennen, ob es eine BASIC-Datei ist und das
  OFN_ReadOnly-Flag entsprechend setzen! }
 var
  S: TS31;
 begin
  OFNHook:=0;
  case Msg of
   WM_InitDialog: begin
    LoadString(Seg(HInstance),108,S,sizeof(S));
    SetDlgItemText(Wnd,ID_OfnWriteProt,S);
   end;
  end{case Msg};
 end;

function lstrcmpin2(LongS,ShortS:PChar):Integer;
{Ist ShortS der Anfang von LongS?}
 var
  c: Char;
  SP: PChar;
 begin
  SP:=LongS+lstrlen(ShortS);
  c:=SP^;
  SP^:=#0;
  lstrcmpin2:=lstrcmpi(LongS,ShortS);
  SP^:=c;
 end;

var
 SFile: TS255;
 SFilter: TS255;
 SExt: TS31;
const
 hm: Word=WM_User+100;	{HelpMessageString-Nachricht}
const
 Ofn: TOpenFileName=(
  lStructSize: sizeof(TOpenFileName);
  hWndOwner: 0;
  hInstance: Seg(HInstance);
  lpstrFilter: SFilter;
  lpstrCustomFilter: SExt;
  nMaxCustFilter: sizeof(SExt);
  nFilterIndex: 0;
  lpstrFile: SFile;
  nMaxFile: sizeof(SFile);
  lpstrFileTitle: nil;
  nMaxFileTitle: 0;
  lpstrInitialDir: nil;
  lpstrTitle: nil;
  Flags: OFN_LongNames or OFN_ShowHelp
    or OFN_EnableHook or OFN_OverwritePrompt;
  nFileOffset: 0;
  nFileExtension: 0;
  lpstrDefExt: nil;
  lCustData: 0;
  lpfnHook: OFNHook;
  lpTemplateName: nil);

procedure PrepareOFN;
 var
  SP1,SP2:PChar;
  I: Integer;
 begin
  hm:=RegisterWindowMessage(HelpMsgString);
  Ofn.hWndOwner:=MainWnd;
  LoadString(Seg(HInstance),107,SFilter,sizeof(SFilter));
  if Integer(Ofn.nFilterIndex)<>0 then begin
   SP1:=SFilter;		{Miábrauch!}
   for I:=Integer(Ofn.nFilterIndex)*2 downto 2	{min. 1x}
   do Inc(SP1,lstrlen(SP1)+1);
{Bug der COMMDLG.DLL bereinigen}
   if lstrcmpin2(SP1,SExt+1)<>0 then begin
    SP2:=SP1+lstrlen(SP1);	{String-Ende}
    memmove(SP1+lstrlen(SExt+1),SP2,SFilter+sizeof(SFilter)-SP2);
    lstrcpy(SP1,SExt+1);	{User-Extension einfgen}
   end;
  end;
  SFile[0]:=#0;
 end;

var
 FNam: TS255;

procedure PutFileName(pBuf:PChar); assembler;
{Dateiname vom globalen String SFile einbauen;
 dabei Name und Erweiterung mit Leerzeichen auffllen.
 Bei Erweiterungen mit 3 gleichen Buchstaben wird diese an den Anfang
 gezogen und 80h addiert, als Extrawurst fr BASIC-Programme und ~Daten}
 asm	cld
	les	di,[pBuf]
	xor	dx,dx		{Merk-Register}
	mov	si,offset SFile
	mov	cx,[ofn.nFileExtension]
	jcxz	@@1		{keine Endung!}
	add	si,ax
	segss	lodsb		{1. Zeichen der Endung}
	cmp	ss:[si],al
	jnz	@@1
	cmp	ss:[si+1],al
	jnz	@@1
	or	al,80h
	stosb
	stosb
	stosb
	inc	dl		{Kennungs-Bit}
@@1:	mov	si,offset FNam
	add	si,[ofn.nFileOffset]
	mov	cx,8
@@l1:	segss	lodsb
	or	al,al
	jz	@@2
	cmp	al,'.'
	je	@@2
	stosb
	loop	@@l1
@@2:	mov	al,' '
	rep	stosb		{Rest mit Leerzeichen auffllen}
	or	dl,dl		{Endung vorgezogen?}
	jnz	@@3
	mov	cx,3
	mov	si,offset FNam
	mov	ax,[ofn.nFileExtension]
	or	ax,ax		{Keine Extension?}
	jz	@@2		{3 Bytes l”schen!}
	add	si,ax
	jmp	@@l1		{Extension <blank-padded> anh„ngen}
@@3: end;

function GetFileName(S,buf:PChar):integer;assembler;
 asm	cld
	push	ds
	 les	di,[S]
	 lds	si,[Buf]
	 xor	dx,dx
	 xor	bx,bx
	 mov	cx,8		{8 Zeichen}
	 lodsb			{1. Zeichen}
	 test	al,al		{Endung am Anfang?}
	 jns	@@1
	 mov	dx,11		{Kennung}
	 add	si,2		{mit dem 4. Zeichen loslegen}
@@l1:	 lodsb
@@1:	 and	al,7Fh
	 cmp	al,' '		{Leer- und Steuerzeichen?}
	 jbe	@@2		{einfach auslassen}
	 stosb			{Alle anderen (auch verbotene W31) in Puffer}
	 inc	bx
@@2:	 loop	@@l1
	 mov	al,'.'
	 stosb			{jetzt kommt die Extension!}
	 inc	bx
	 sub	si,dx		{Korrektur, wenn Extension vorn war!}
	 mov	cx,3
@@l2:	 lodsb
	 and	al,7Fh
	 cmp	al,' '
	 jbe	@@3
	 stosb
	 inc	bx
@@3:	 loop	@@l2
	 xor	al,al
	 stosb			{Terminierende Null}
@@e:	pop	ds
	mov	ax,bx
 end;

function LoadFile:Boolean;
 var
  BytesWritten:Longint;
  f,Add,I: Integer;
  Sum: Byte;
  pBuf: PChar;
  buf: TBlock;
  hLdr: THandle;
  C: Char;
 begin
  LoadFile:=false;
  PrepareOfn;
  with ofn do begin
   Flags:=Flags or OFN_FileMustExist;
   if not GetOpenFileName(ofn) then exit;
   f:=_lopen(SFile,0);
   if f=-1 then exit;
   BytesToWrite:=_llseek(f,0,2);	{Dateil„nge}
   _llseek(f,0,0);			{Zeiger zurck}
   Add:=0;
   if nFilterIndex=2 then Add:=11;
   If coding=2 Then begin
    hLdr:=LoadResource(Seg(HInstance),	{Turboloadervorblock}
      FindResource(Seg(HInstance),MakeIntResource(102),RT_RCData));
    if hLdr=0 then RunError(220);
    hBuffer:=GlobalAlloc(GMEM_MoveAble or GMEM_Share,BytesToWrite+256);
    pBuf:=GlobalLock(hBuffer);
    MemMove(pBuf,Ptr(hLdr,0),GlobalSize(hLdr));
    hLdr:=THandle(FreeResource(hLdr));
    case nFilterIndex of
     1: begin
	_hread(f,pBuf+$100,$80);
	asm
	 les	di,[pBuf]
	 mov	si,di
	 add	si,80h
	 mov	cx,0Bh
@@l1:	 seges	lodsb	{Name bertragen}
	 stosb
	 loop	@@l1
	 add	si,85h  {Adressen bertragen}
	 add	di,76h
	 seges	lodsb
	 push	ax	{ARGN}
	  seges	lodsw   {AADR}
	  stosw
	  mov	cx,ax
	  inc	di
	  seges	lodsw	{EADR}
	  stosw
	  xchg	ax,cx
	  sub	ax,cx
	  add	di,22h
	  stosw		{L„nge}
	 pop	ax
	 cmp	al,3
	 jnz	@@e
	 mov	al,0C3h
	 add	di,36h
	 stosb
	 seges	lodsw	{SADR}
	 stosw
@@e:	end;
	BytesWritten:=_hread(f,pBuf+$100,BytesToWrite-$80);
	sum:=0;
	for i:=$100 to Byteswritten do inc(sum,byte(pBuf[I]));
	pBuf[$D8]:=char(Sum);
	inc(BytesWritten,$80);
     end;
     2: Add:=$100;
     3: begin;
	PutFileName(pBuf);
	_hread(f,pBuf+$100,2);
	asm
	 les	di,[pBuf]
	 mov	si,di
	 add	si,70h
	 add	di,80h
	 mov	cx,10
@@l1:	 seges	lodsb
	 stosb
	 loop	@@l1
	 add	si,86h
	 seges	lodsw
	 inc	ax
	 sub	di,9
	 stosw		{BASIC-L„nge [3D7]}
	 sub	ax,400
	 add	di,25h
	 stosw		{File-L„nge}
	 add	di,56h
	 xor	al,al
	 stosb
	end;
	BytesWritten:=_hread(f,pBuf+$100,BytesToWrite-2);
	sum:=0;
	for i:=$100 to Byteswritten do inc(sum,byte(pBuf[I]));
	pBuf[$D8]:=char(Sum);
	inc(BytesWritten,2);
     end;
     4: exit; {Unsinn!}
    end;
    GlobalUnlock(hBuffer);
   end
   else begin
    hBuffer:=GlobalAlloc(GMEM_MoveAble or GMEM_Share,BytesToWrite+Add);
    pBuf:=GlobalLock(hBuffer);
    if Add<>0 then PutFileName(pBuf);
    BytesWritten:=_hread(f,pBuf+Add,BytesToWrite);
    GlobalUnlock(hBuffer);
   end;
   if (_lclose(f)<>0) or (BytesWritten<>BytesToWrite) then begin
    MBox1(MainWnd,105,SFile);
    hBuffer:=GlobalFree(hBuffer);
    exit;
   end;
   Inc(BytesToWrite,Add);
   LoadFile:=true;
  end;
 end;

function SaveFile:Boolean;
 var
  BytesWritten: Longint;
  f,Add: Integer;		{0 oder 11}
  pBuf: PChar;
  C: Char;
 begin
  SaveFile:=false;
  Add:=0;
  PrepareOfn;
{fr Turbolader h#s und Z1013 Dateinamensinklusion weglassen}
  pBuf:=GlobalLock(hBuffer);
  GetFileName(SFile,pBuf);
  with ofn do begin
   if pBuf[0]<char($80) then Flags:=Flags or OFN_ReadOnly
    else Flags:=Flags and not OFN_ReadOnly;
   Flags:=Flags or OFN_PathMustExist;
   if not GetSaveFileName(ofn) then exit;
   if coding=2 then begin
    if pBuf[$D8]<>pBuf[BufPtr-1] then
	if MBox1(MainWnd,111,FNam)=IDCANCEL then exit;
    if pBuf[$80]=char($21) then begin {Maschinenprg.}
     Dec(BufPtr,$81);
     asm
	les	di,[pBuf]
	mov	si,di
	add	di,11
	xor	ax,ax
	mov	cx,6
	rep	stosb
	add	si,81h
	seges	lodsw
	stosw
	inc	si
	seges	lodsw
	stosw
	add	si,5Ah
	sub	di,5
	push	si
	 seges	lodsb
	 cmp	al,0C3h
	 jnz	@@1
	 mov	al,3
	 stosb
	 add	di,4
	 seges	lodsw
	 jmp	@@2
@@1:	 mov	al,2
	 stosb
	 add	di,4
	 xor	ax,ax
@@2:	 stosw
	 mov	cx,69h
	 xor	ax,ax
	 rep	stosb
	pop	si
	add	si,20h
	mov	cx,word[BufPtr]
@@3:	seges	lodsb
	stosb
	loop	@@3
     end;
    end else begin {BASIC Prg.}
     asm
	les	di,[pBuf]
	mov	si,di
	add	si,81h
	seges	lodsw
	dec	ax
	stosw
	add	si,7Eh
	mov	cx,word[BufPtr]
@@1:	seges	lodsb
	stosb
	loop	@@1
     end;
     Dec(BufPtr,$100);
    end;
   end else begin
    if Flags and OFN_ReadOnly <>0 then
     if pBuf[0]>char($7F) then begin
      Add:=11;
      if pBuf[0]=char($D3) then BufPtr:=byte(pBuf[11])+byte(pBuf[12])*256+14;
     end else Add:=$80;
   end;
   f:=_lcreat(SFile,0);
   if f=-1 then begin
    GlobalUnlock(hBuffer);
    exit;
   end;
   Dec(BufPtr,Add);
   BytesWritten:=_hwrite(f,pBuf+Add,BufPtr);
   GlobalUnlock(hBuffer);
   if (_lclose(f)<>0) or (BytesWritten<>BufPtr) then begin
    MBox1(MainWnd,106,SFile);
    exit;
   end;
   SaveFile:=true;
  end;
 end;

function GetInt(var S: PChar; Def:Integer):Integer;
 var
  SP: PChar;
  I,J: Integer;
 begin
  GetInt:=Def;
  if S=nil then exit;
  SP:=lStrChr(S,' ');
  if SP<>nil then begin
   SP^:=#0;
  end;
  Val(S,I,J);
  if SP<>nil then S:=SP+1;
  if J=0 then GetInt:=I;
 end;


procedure HandleMMError(Code:Integer);
 var
  S: array[0..255] of Char;
 begin
  case Code of
   MMSysErr_Allocated: MBox1(MainWnd,102,nil);
   WAVERR_Sync: MBox1(MainWnd,101,nil);
   else begin
    WaveInGetErrorText(Code,S,sizeof(S));
    MBox1(MainWnd,103,S)
   end;
  end;
 end;

procedure SetModus(NewModus:Integer);
 begin
  if Modus<>NewModus then begin
   Modus:=NewModus;
   EnableWindow(GetDlgItem(MainWnd,1),Modus=0);
   EnableWindow(GetDlgItem(MainWnd,22),Modus=0);
   ShowWindow(GetDlgItem(MainWnd,2),Integer(Modus<>0));
   ShowWindow(GetDlgItem(MainWnd,3),Integer(Modus=0));
  end;
  if GetFocus=0 then SetFocus(GetDlgItem(MainWnd,12));
 end;

function GetLibProc(Entry:PChar):TFarProc;
 var
  P: TFarProc;
  LibName: TS31;
 begin
  GetLibProc:=nil;
  SendDlgItemMsgP(MainWnd,12,CB_GetLbText,coding,@LibName);
  LibInst:=LoadLibrary(LibName);
  if LibInst<32 then begin
   MBox1(MainWnd,114,LibName);
   exit;
  end;
  P:=GetProcAddress(LibInst,Entry);
  if P=nil then begin
   MBox1(MainWnd,115,Entry);
   FreeLibrary(LibInst);
   LibInst:=0;
   exit;
  end;
  GetLibProc:=P;
 end;

procedure DoEndProcess(OK:Boolean);
 begin
  if OK and (Modus=1) then SaveFile;
  if hBuffer<>0 then hBuffer:=GlobalFree(hBuffer);
  if LibInst>=32 then FreeLibrary(LibInst);
  SetModus(0);
 end;

procedure Change(Wnd:HWnd;ID:Word;Min,Max:Integer;B:Boolean);
 var
  I,C: Integer;
  OK: Bool;
 begin
  I:=GetDlgItemInt(Wnd,ID,@OK,true);
  if not OK then exit;
  If B Then begin If (I<Max) Then Inc(I) end
       Else If (I>Min) Then Dec(I);
  SetDlgItemInt(Wnd,ID,I,true);
 end;

function LoadProc(Wnd:HWnd; Msg,wParam:Word; lParam:LongInt):Bool; export;
 var
  lPar: LongRec absolute lParam;
  WH: PWaveHdr absolute lParam;
  S: array[0..255] of Char;
  WaveOutCaps: TWaveOutCaps;
  WaveInCaps: TWaveInCaps absolute WaveOutCaps;	{ist krzer!}
  LF: TLogFont absolute S;
  SP: PChar;
  Proc: TFarProc absolute SP;
  W: Word;
  I,J,K: Integer;
  B: Bool absolute K;
  vsrec: array[0..4] of Integer;
 begin
  LoadProc:=false;

  case Msg of
   WM_InitDialog: begin
    MainWnd:=Wnd;		{Globale Variable setzen}
    W:=GetSystemMenu(Wnd,false);
    DeleteMenu(W,SC_Zoom,MF_ByCommand);
    DeleteMenu(W,SC_Size,MF_ByCommand);
    ShowWindow(Wnd,CmdShow);	{Icon? - Sofort wirksam machen!}
    Back:=CreateSolidBrush($FF0000);	{Blau}
    PostMessage(Wnd,WM_ContinueInit,0,0);
   end;

   WM_ContinueInit: begin
    UpdateWindow(Wnd);		{wrde in InitDialog nichts bringen !!}
    SP:=nil;
    if RegGetRoot(RegPath,S,sizeof(S)) then begin
     SP:=S;
     Installed:=true;
    end;
    Retries:=GetInt(SP,4);
    Coding:=GetInt(SP,0);
    WaveVol:=GetInt(SP,4);
    WaveInDev:=GetInt(SP,0);
    WaveOutDev:=GetInt(SP,0);
    SetDlgItemInt(Wnd,11,Retries,true);
    LoadString(Seg(HInstance),104,S,sizeof(S));
    SP:=S;
    W:=GetDlgItem(Wnd,12);
    while SP^<>#0 do begin
     SendMessageP(W,CB_AddString,0,SP);
     Inc(SP,lstrlen(SP)+1);
    end;
    SendMessageP(W,CB_Dir,0,PChar(UserDllFilter));
    SendMessage(W,CB_SetCurSel,Coding,0);
    SetDlgItemInt(Wnd,13,WaveVol,true);
    W:=GetDlgItem(Wnd,14);	{Handle Kombobox WaveIN}
    LoadString(Seg(HInstance),112,S,sizeof(S));
    K:=SendMessageP(W,CB_AddString,0,@S);
    SendMessage(W,CB_SetItemData,K,-2);
    I:=WaveInGetNumDevs;
    for J:=-1 to I-1 do begin	{mit Wave_Mapper beginnen}
     if (WaveInGetDevCaps(Word(J),@WaveInCaps,sizeof(WaveInCaps))=0)
     and (WaveInCaps.dwFormats and WAVE_Format_2M08 <>0) then begin
      K:=SendMessageP(W,CB_AddString,0,@WaveInCaps.szPName);
      SendMessage(W,CB_SetItemData,K,J);
      if J=WaveInDev then SendMessage(W,CB_SetCurSel,K,0);
     end;
    end;
    W:=GetDlgItem(Wnd,15);	{Handle Kombobox WaveOUT}
    K:=SendMessageP(W,CB_AddString,0,@S);
    SendMessage(W,CB_SetItemData,K,-2);
    I:=WaveOutGetNumDevs;
    for J:=-1 to I-1 do begin	{mit Wave_Mapper beginnen}
     if (WaveOutGetDevCaps(Word(J),@WaveOutCaps,sizeof(WaveOutCaps))=0)
     and (WaveOutCaps.dwFormats and WAVE_Format_1M08 <>0)
     and (WaveOutCaps.dwSupport and WAVECAPS_Sync =0) then begin
      K:=SendMessageP(W,CB_AddString,0,@WaveOutCaps.szPName);
      SendMessage(W,CB_SetItemData,K,J);
      if J=WaveOutDev then SendMessage(W,CB_SetCurSel,K,0);
     end;
    end;
    GetObject(SendMessage(Wnd,WM_GetFont,0,0),sizeof(lf),@lf);
    lstrcpy(lf.lfFaceName,'Courier');
    SendDlgItemMessage(Wnd,10,WM_SetFont,CreateFontIndirect(lf),0);
   end;

   WM_CtlColor: if (lPar.Hi=CtlColor_Static)
   and (GetWindowWord(lPar.Lo,GWW_ID)=10) then begin
    LoadProc:=Bool(Back);
    SetTextColor(wParam,$FFFFFF);
    SetBkMode(wParam,Transparent);
   end;

   WM_EndProcess: DoEndProcess(Boolean(wParam));

   WM_SetStatus: SetDlgItemText(Wnd,10,PChar(lParam));

   WM_ReportWaveError: begin	{in MMTASK Fehler bei WaveInOpen()}
    HandleMMError(wParam);
    hBuffer:=GlobalFree(hBuffer);
    SetModus(0);
   end;

   WM_VScroll: begin
    lPar.Lo:=GetDlgCtrlID(GetWindow(lPar.Hi,GW_HWndPrev));
    if (wParam=SB_LineUp) or (wParam=SB_LineDown) then begin
     Change(Wnd,lPar.Lo,0,7,wParam=SB_LineUp);
    end;
   end;

   WM_QueryEndSession: if (Modus<>0)
   and (MBox1(Wnd,113,nil)<>IDYes) then LoadProc:=true;

   WM_EndSession: if Bool(wParam) and Installed
   then SendMessage(Wnd,WM_Command,23,0);

   WM_Close: begin
    if (Modus<>0) then begin
     if MBox1(Wnd,113,nil)<>IDYes then begin
      LoadProc:=true;		{Nicht beenden!}
      exit;
     end;
     SendMessage(Wnd,WM_Command,IDCancel,0);
    end;
    DeleteObject(Back);
    if Installed then SendMessage(Wnd,WM_Command,23,0);
    EndDialog(Wnd,1);
   end;

   WM_Command: case wParam of
{Žnderungen an den Eingabe-Elementen erfassen}
    11: if lPar.Hi=EN_Change then begin
     I:=GetDlgItemInt(Wnd,wParam,@B,true);
     if B and (I>=0) and (I<=255) then Retries:=I;
    end;
    12: if lPar.Hi=CBN_SelChange then begin
     I:=SendMessage(lPar.Lo,CB_GetCurSel,0,0);
     if I>=0 then Coding:=I{SendMessage(lPar.Lo,CB_GetItemData,I,0)};
    end;
    13: if lPar.Hi=EN_Change then begin
     I:=GetDlgItemInt(Wnd,wParam,@B,true);
     if B and (I>=0) and (I<=7) then begin
      WaveVol:=I;
      I:=sqr(WaveVol)*2;
      if Amp>=0 then Amp:=I else Amp:=-I;
     end;
    end;
    14: if lPar.Hi=CBN_SelChange then begin
     I:=SendMessage(lPar.Lo,CB_GetCurSel,0,0);
     if I>=0 then WaveInDev:=SendMessage(lPar.Lo,CB_GetItemData,I,0);
    end;
    15: if lPar.Hi=CBN_SelChange then begin
     I:=SendMessage(lPar.Lo,CB_GetCurSel,0,0);
     if I>=0 then WaveOutDev:=SendMessage(lPar.Lo,CB_GetItemData,I,0);
    end;
{Tastendrcke}
    3: SendMessage(Wnd,WM_Close,0,0);	{Programmende}

    IDCancel: begin			{Abbruch}
     LoadString(Seg(HInstance),110,S,sizeof(S));
     SetDlgItemText(MainWnd,10,S);
     if Modus<>0 then begin
      if IsTask(Task) then PostAppMessage(Task,WM_Quit,0,0)
      else SetModus(0);
     end;
    end;

    1: if Modus=0 then begin		{Datei einlesen}
     case coding of
      0: Proc:=@ReadDataKCC;
      1: Proc:=@ReadDataMPMTurbo;
      2: Proc:=@ReadDataHSTurbo;
      3: Proc:=@ReadDataZ1013;
      4: Proc:=@ReadDataBasicode;
      else begin
       Proc:=GetLibProc('LOAD');		{Benutzer-definiert...}
       if Proc=nil then exit;
      end;
     end;
     hBuffer:=GlobalAlloc(GMEM_MoveAble or GMEM_Share,$8000);
     BufPtr:=0;
     SetModus(1);
     MMTaskCreate(@WaveInTask,Task,LongInt(Proc));
    end;

    22: if Modus=0 then begin		{Datei ausgeben}
     if not LoadFile then exit;
     case coding of
      0: Proc:=@WriteDataKCC;
      1: Proc:=@WriteDataMPMTurbo;
      2: Proc:=@WriteDataHSTurbo;
      3: Proc:=@WriteDataZ1013;
      4: Proc:=@WriteDataBasicode;
      else begin
       Proc:=GetLibProc('SAVE');
       if Proc=nil then exit;
      end;
     end;
     BufPtr:=0;
     Amp:=sqr(WaveVol)*2;
     SetModus(2);
     MMTaskCreate(@WaveOutTask,Task,LongInt(Proc));
    end;

    23: begin
     Installed:=true;
     wvsprintf(S,'%d %d %d %d %d',Retries);
     RegSetRoot(RegPath,S);
    end;

    9: WinHelp(Wnd,HelpFileName,HELP_Contents,0);

   end{WM_Command};
  else if Msg=hm then WinHelp(Wnd,HelpFileName,HELP_Context,1);
  end;
 end;

const
 wc:TWndClass=(
  style:	CS_VRedraw or CS_HRedraw;
  lpfnWndProc:	@DefDlgProc;
  cbClsExtra:	0;
  cbWndExtra:	DlgWindowExtra;
  hInstance:	Seg(HInstance);
  hIcon:	0;
  hCursor:	0;
  hbrBackground:Color_Background+1;
  lpszMenuName: nil;
  lpszClassName:'KCLOAD');

{FAR+EXPORT-Wrapper-Routinen (interne Routinen arbeiten mit NEAR)}
function ReadSwing:Integer; export;
 begin ReadSwing:=ReadSwing1; end;

procedure WriteSwing(Len:Integer); export;
 begin WriteSwing1(Len); end;

procedure EndProcess(OK:Boolean); export;
 begin EndProcess1(OK); end;

procedure SetStatus(S:PChar); export;
 begin SetStat(S); end;

function GetSizeData:Longint; export;
 begin GetSizeData:=GetSize; end;

function GetDataBlock(P:PChar; Size:Integer):Integer; export;
 begin GetDataBlock:=GetData(P,Size); end;

procedure AddDataBlock(P:PChar; Size:Integer); export;
 begin AddData(P,Size); end;

exports
 ReadSwing	index 2,	{Fluáwechsel lesen}
 WriteSwing	index 3,	{Fluáwechsel schreiben}
 EndProcess	index 4,	{Vorzeitig abbrechen}
 SetStatus	index 5,	{Statuszeile setzen}
 GetSizeData    index 6,	{restliche Bytes ermitteln}
 GetDataBlock	index 7,	{N„chsten Datenblock aus Puffer lesen}
 AddDataBlock	index 8;	{Neuen Datenblock in Puffer anh„ngen}

begin
 LoadString(Seg(HInstance),100,AppName,sizeof(AppName));
 WUtils.StdMBoxTitle:=AppName;	{MessageBox-Titel in Unit setzen}
 if HPrevInst<>0 then begin	{Nicht doppelt starten!}
  MainWnd:=FindWindow('KCLOAD',nil);
  SetActiveWindow(MainWnd);
  ShowWindow(MainWnd,SW_Restore);
  halt(221);
 end;
 wc.hIcon:=LoadIcon(Seg(HInstance),MakeIntResource(100));
 wc.hCursor:=LoadCursor(0,IDC_Arrow);
 RegisterClass(wc);
 DialogBox(Seg(HInstance),MakeIntResource(100),0,@LoadProc);
end.

Test fr das MFM-Verfahren am KC
 var
  I,J,W:Integer;
  B:Byte;
 begin
  {Loader saven, Adressen und CTC poken}
  for I:=0 to 2000 do WriteSwing1(6);
  WriteSwing1(12);WriteSwing1(12);
  J:=0;I:=7;
  while GetData(PChar(@B),1)<>0 do begin
   for I:=0 to 7 do begin
    case J of
     0: if B and 1 =0 then begin WriteSwing1(6);end
	else begin WriteSwing1(19);J:=1;end;
     1: if B and 1 =0 then begin J:=2;end
	else begin WriteSwing1(6);end;
     2: if B and 1 =0 then begin WriteSwing1(12);J:=0;end
	else begin WriteSwing1(19);J:=1;end;
    end;
    B:=B shr 1;
   end;
  end;
 end;

Detected encoding: UTF-80