For everybody....
You can use/modify/delete/print/eat (or whatever) the source-code...

It uses the Microsoft-FNT-Font-Format
that means you can create fonts with the Borland Resource Workshop
(shipped with Borland Pascal 7.0 or Turbo Pascal for Win 1.5)
every char should be 8 x 16 pixels

Greetings to everybody,
Michael    see also: GraphiX by Michael Knapp

====================================

PROGRAM useyourownfont;

USES crt;

{comment by F.Glaser: This program seems to be made for BP 7 with DPMI,
 but shall work with minor modification with TP 7 too}

PROCEDURE char8bitwide; assembler;
ASM
  MOV    DX,03DAh
  IN     AL,DX
  MOV    DX,03C0h
  MOV    AL,30h
  OUT    DX,AL
  INC    DX
  IN     AL,DX
  AND    AL,0F3h
  DEC    DX
  OUT    DX,AL
END;

PROCEDURE char8bitmode; assembler;
ASM
  MOV    DX,03C4h
  MOV    AL,01h
  OUT    DX,AL
  INC    DX
  IN     AL,DX
  OR     AL,01h
  OUT    DX,AL
END;

PROCEDURE setasciichar(ch,height:byte;var data);
VAR offset : Word;
BEGIN
  IF height>16 THEN height:=16;
  offset:=ch*32;
  Inline($FA);   {cli}
  portW[$3C4]:=$0402;
  portW[$3C4]:=$0704;
  portW[$3CE]:=$0204;
  portW[$3CE]:=$0005;
  portW[$3CE]:=$0006;
  move(data,ptr(SegA000,offset)^,height);   {SegA000 = DPMI-mode, simply use $A000}
  fillchar(Ptr(SegA000,offset+height)^,16-height,0);
  portW[$3C4]:=$0302;
  portW[$3C4]:=$0304;
  portW[$3CE]:=$0004;
  portW[$3CE]:=$1005;
  portW[$3CE]:=$0E06;
  inline($FB);   {sti}
END;

PROCEDURE setspecialtextmode;
BEGIN
  char8bitwide;
  char8bitmode;
END;

PROCEDURE setfont(datei:string);
TYPE TCharInfo=RECORD
       width:word;
       offset:word;
     END;

     PFontHeader=^TFontHeader;
     TFontHeader=RECORD
       dfVersion:word;
       dfSize:longint;
       dfCopyright:array[1..60] of char;
       dfType:word;
       dfPoints:integer;
       dfVertRes:integer;
       dfHorizRes:integer;
       dfAscent:integer;
       dfInternalLeading:integer;
       dfExternalLeading:integer;

       dfItalic:byte;
       dfUnderline:byte;
       dfStrikeOut:byte;
       dfWeight:integer;
       dfCharSet:byte;
       dfPixWidth:integer;
       dfPixHeight:integer;
       dfPitchAndFamily:byte;
       dfAvgWidth:integer;
       dfMaxWidth:integer;
       dfFirstChar:byte;
       dfLastChar:byte;
       dfDefaultChar:byte;
       dfBreakChar:byte;
       dfWidthBytes:integer;
       dfDevice:byte;
       dfFace:byte;
       dfBitsPointer:integer;
       dfBitsOffset:integer;
       dfReserved:integer;
       dfFlags:integer;
       dfAspace:byte;
       dfBspace:byte;
       dfCspace:byte;
       dfColorpoints:word;
       dfReserved1:integer;
       dfCharTable:array[0..255] of TCharInfo;
     END;

    PFontInfo=^TFontInfo;
    TFontInfo=RECORD
       FontPtr:PFontHeader;
       FontSize:word;
     END;

VAR i:byte;
    f:file;
    io:word;
    font:PFontinfo;
    ch:byte;
    fontseg,fontofs:word;
BEGIN
  assign(f,Datei);
  reset(f,1);
  new(Font);
  WITH Font^ DO
    BEGIN
      FontSize:=filesize(f);
      getmem(FontPtr,FontSize);
      blockread(f,FontPtr^,FontSize,io);
    END;
  close(f);
  fontseg:=seg(Font^.FontPtr^);
  fontofs:=ofs(Font^.FontPtr^);
  WITH Font^.FontPtr^ DO
    FOR i:=0 TO 255 DO
      BEGIN
        ch:=i;
        IF (ch>=dfFirstChar) AND (ch<=dfLastChar) THEN
          dec(ch,dfFirstChar)
        ELSE
          ch:=dfDefaultChar;
        setasciichar(i,dfpixheight,ptr(fontseg,fontofs+dfCharTable[ch].offset)^);
      END;
  freemem(Font^.FontPtr,Font^.FontSize);
  Dispose(Font);
END;

VAR i,j:integer;

BEGIN
  clrscr;
  setspecialtextmode;
  setfont('YOURFONT.FNT');
  FOR j:=1 TO 24 DO
    FOR i:=1 TO 80 DO write(chr(64+j));
  readkey;
{  textmode(co80); }
END.

no@junk.mail (Ray Lischner) wrote:

>On 19 Jan 1999 18:25:56 GMT, "Emmanuel Derriey" <ederriey@at-iris.com>
>wrote:
>
>>I try to print the Euro symbol in my program.
>>I have downloaded a version of 'Tahoma' font (that I use) with the Euro
>>symbol. I 've watched with CharMap utility and I 've seen that it is a
>>unicode code (20ac).
>
>The Euro symbol has the numeric value of #128 in my Euro-updated Tahoma
>font.

That's not quite accurate.

TrueType fonts are Unicode.  The Tahoma font, like the rest of Microsoft's
euro-enabled fonts, has the character at the standard location U+20AC.

Microsoft, on its own, has chosen to map character code 128 in its US-ASCII
code page to this character.  This is strictly a Microsoft invention,
unrelated to international standard.  The ISO standard places the euro
symbol at character 164 in character set ISO-8859-15, which is called
Latin9.

So, assuming you're set up for US-ASCII, you can enter ALT-0128 in a
Windows app, and it will display as a euro character.  But you can't hope
to send that to any non-Microsoft person and get anything useful.  In
particular, I've been trying for a couple of weeks to have a euro character
survive through e-mail, without success.
--
- Tim Roberts, timr@probo.com
  Providenza & Boekelheide, Inc.

oscar wrote:
> Is it possible to read the contents of a cell within an Excel-sheet into an
> array in Delphi 3.0 ? If yes , can you please provide me with an example.
> thanks in advance, Oscar
> o.kula @wxs.nl

Here is something I got from these forums at an earlier time on this topic.

Posted by: Andy Jeffries ajeffries@kwikrite.clara.net

function TDemoForm.ReadCellValue(XLFileName:String; Column, Row :Integer):String;
var
  xlApp : Excel_TLB._Application;
  WorkBookFileName : WideString;
  xlWorkBook : WorkBook;
  xlWorkSheet : WorkSheet;
begin
  //create an instance of the Microsoft Excel Application
  xlApp := CoApplication_.Create;
  try
    WorkBookFileName := WideString(XLFileName);
    xlWorkBook := xlApp.WorkBooks.Open(WorkBookFileName, 0, true,
                  EmptyParam, EmptyParam, EmptyParam, EmptyParam,EmptyParam,
                  EmptyParam, EmptyParam, EmptyParam, EmptyParam,EmptyParam, 0);
    {Open the Edit1.Text workbook, without updating anything and
     read-only. The final '0' parameter is for lcid and I have no idea
     what this does or  why the 0 works, but replacing it with other
     values causes nasty errors.}
    xlWorkSheet := xlWorkBook.WorkSheets.Get_Item(1) as _WorkSheet;
    {Get the first Worksheet in the book}
    Result := xlWorkSheet.Cells.Item[Row, Column].Text;
    {Read the items.}
  finally
    xlApp.DisplayAlerts[0] := False;  // Discard unsaved files....
    xlApp.Quit;//Close the application, no need to free any objects,
                 Delphi does that for you
  end;
end;
--                 \|||/
                   /'^'\
                  ( 0 0 )
--------------oOOO--(_)--OOOo--------------
. Reid Roman  Delphi Programmer           .
. TVisualBasic:=class(None)               .
. May the Source be With You              .
-------------------------------------------
. Auto-By-Tel (http://www.autobytel.com)  .
. Irvine, CA U.S.A                        .
-------------------------------------------

Just use this

asm
    mov ax,16B8h
    xor bx,bx
    int 02fh
end;

Greetz Bas
---------------
e-mail:   BasNeder@cal020014.student.utwente.nl  ICQ# 3609096

Rich Pasco wrote in message <36A8A288.70CA@best.com>...
>sybaris@chez.com wrote:
>
>>I have made a program in Tp7 witch could work well only if you are in
>>full screen in a dos command. (ALT + ENTER key switch between full
>>screen and window screen command)
>>My problem is how to do in Tp7 or Asm to switch to full screen mode ??
>
>Gerd wrote:
>> if you set a graphics video mode you'll get a full screen display.
>But on returning to previous text mode, the screen returns to a window.
>How to make it stay full-screen, even in text mode?
>     - Rich

Rui Soares wrote:

> I need to write some code that would return a random value using a
> gaussian distribution with parameters mean (m)  and variance (v) -
> N(m,v)
>
> Can anyone help me with this or give me some hints to get started?

     What do you know about the mathematics of probability density
functions, and about the Gaussian distribution, in particular?  If you
are mathematically savvy, there are two
algorithms (one "quick and dirty", the other more exact and interesting,
though slower) I could suggest.  If the math is not your thing, then I'd
suggest going to the library and looking up, perhaps in Knuth's book
"The Art of Computer Programming", the algorithm(s).

     The Quick/Dirty method uses the fact that the mean tends toward a
normal distribution.  In particular, if you sum, say, 12
uniformly-distributed numbers, their sum (which is closely related to
their mean) is approximately normally distributed.  It is left as the
proverbial Exercise For the Reader to determine the mean and standard
deviation.

     The Exact method relies on the usual proof that the integral of
exp(-sqr(x)) is sqrt(2*pi).  You basically throw darts at a
(transformed) circular bulls-eye.

     Finally, one typically tries to generate N(0,1) random variables
(mean 0, variance 1).
To get N(mu, var), you just compute mu + var*N(0,1).

Bob Schor
Pascal Enthusiast

P.S. -- despite its "slowness" (because it requires computing
transcendental functions, like sine, cos, and log), I like, and use, the
Exact algorithm, myself.

On Fri, 22 Jan 1999 17:28:31 -0500, "ede" <ede@integrityonline30.com>
wrote:

>I can work with it in RGB if I cannot get the resources I need to learn YUV.

I completely forgot to give you some conversion formulas for
byte-sized RGB to byte-sized YUV:

Luminance:
 Y := 0.3 * R + 0.6 * G + 0.1 * B;

or sometimes
 Y := 0.30 * R + 0.59 * G + 0.11 * B;

Chrominance:
 U := B - Y;
 V := R - Y;

The chrominance formulas result in some values less than zero, so
they're often normalized:
 Cb := (U / 2) + 0.5;
 Cr := (V / 1.6) + 0.5;

However, these normalized values are sometimes still called U and V;
other times, the U and V bytes are considered to be signed. You'd have
to check your files and determine which interpretation is being used
by them.

-Steve

dEpperson:

ede wrote in message <76its9$29718@forums.borland.com>...
>Are there any good resource manuals on YUV?  And can you manipulate a YUV
>file in D3.
>I've done bitmap and jpeg, EMF manipulation of bitmap, but I've never seen
>anything in D3 for YUV.  Got a big project coming up so would appreciate any
>help.

I worked with someone named Daniel ("D.Halan" <me21536@elvis.swipnet.se>)
in converting his YUV files to RGB format for display in Delphi.
The code below was for a specific YUV file (but it was
proprietary so I can't give you that as part of the example).
Perhaps the code will help you get started.

For general information about various color spaces and conversions,
look for the "Color Conversion" and "Color Spaces" in Section A
(Color Information) at
http://www.efg2.com/lab/library/Color.htm

efg
efg's Computer Lab:       http://www.efg2.com/lab

On Sat, 23 Jan 1999 09:43:28 +0100, "Michael Justin"
<michael.justin@postkasten.de> wrote:
>I am looking for a component for easy and fast date & time input, so it
>should be a MaskEdit style. But it should also be able to display and accept
>the date and time according to the Windows country settings.
>It should also have a built-in y2k fix (00 -> 2000).

If you feel like being a guinea pig, you can download

    ! http://home.att.net/~drifkind/download/datetime.zip (24kB)
! TP-links-mirror (24kB)

It's a date/time edit control with spin buttons, formatting based on
FormatDateTime, and some other stuff.  I just finished writing it, but
think it's pretty solid.  It should handle international formatting
pretty well, and has an epoch setting to deal with the end of century.

--
Report all obscene mail to your Potsmaster.

Hey, Joe sent me a snippet to capture the screen. Here it is all wrapped up
into a neat little function:

-----------------------------------------------
procedure ScreenShot(x : integer;
                     y : integer;
                     Width : integer;
                     Height : integer;
                     bm : TBitMap);
var
  dc: HDC;
  lpPal : PLOGPALETTE;
begin
 {test width and height}
  if ((Width = 0) OR
      (Height = 0)) then begin
    exit;
  end;
  bm.Width := Width;
  bm.Height := Height;
 {get the screen dc}
  dc := GetDc(0);
  if (dc = 0) then begin
    exit;
  end;
 {do we have a palette device?}
  if (GetDeviceCaps(dc, RASTERCAPS) AND
      RC_PALETTE = RC_PALETTE) then begin
   {allocate memory for a logical palette}
    GetMem(lpPal,
           sizeof(TLOGPALETTE) +
           (255 * sizeof(TPALETTEENTRY)));
   {zero it out to be neat}
    FillChar(lpPal^,
             sizeof(TLOGPALETTE) +
             (255 * sizeof(TPALETTEENTRY)),
             #0);
   {fill in the palette version}
    lpPal^.palVersion := $300;
   {grab the system palette entries}
    lpPal^.palNumEntries :=
      GetSystemPaletteEntries(dc,
                              0,
                              256,
                              lpPal^.palPalEntry);
    if (lpPal^.PalNumEntries <> 0) then begin
     {create the palette}
      bm.Palette := CreatePalette(lpPal^);
    end;
    FreeMem(lpPal, sizeof(TLOGPALETTE) +
            (255 * sizeof(TPALETTEENTRY)));
  end;
 {copy from the screen to the bitmap}
  BitBlt(bm.Canvas.Handle,
         0,
         0,
         Width,
         Height,
         Dc,
         x,
         y,
         SRCCOPY);
 {release the screen dc}
  ReleaseDc(0, dc);
end;
------------------------------------------------------------

I hope this helps a little.
Davie

Bryan Valencia wrote:

> Why doesn't this load a picture of my desktop into the timage PIC, and
> then save it as a BMP file?
>
> I get a totally white 320x200 bmp file.
>
> var
>         Pic:timage;
>         DESKDC, MYDC:HDC;
>
>         Jpg: TJpegImage;
>         S: TMemoryStream;
>         P: TPicture;
>
> begin
>         DESKDC  := GetDC(0);
>
>         Pic                     := tImage.create(self);
>         Pic.Picture.Bitmap.Width:=320;
>         pic.Picture.Bitmap.Height:=200;
>
>         MYDC            := GetDC(PIC.Picture.Bitmap.Handle);
>
>         Pic.Picture.Bitmap.Canvas.TextOut(1,1,Request.UserAgent);
>         StretchBlt(MyDc, 0,0,320,200,DESKDC, 0,0, 1280, 1024, SRCcopy);
>
>         pic.Picture.SaveToFile('c:\Images\NewImage.bmp');
>
> --
> Bryan Valencia
> Software Services
> Software Services Home Page  http://www.209software.com
> Pascal for Delphi Programmers
> http://www.209software.com/p4dp/Book.html

> - How can I call a Windows 95 API procedure, as it is done in Win32
> assembly programs, from within an ASM block?

AFAIK tpw creates 16-bit applications. To call 32-bit functions, you
need an interface called Call32NT (by Christian Ghisler).

> - When using TStatic to display text in a window, the font is always
> bold. How can I use another font (style)? Same with dialogs.

Here is a thin font unit. You have to call SetThinDlgFont() at the
WM_INITDIALOG.

unit ThinFont;

interface
uses WinTypes, WinProcs;

procedure SetThinDlgFont(dlg: hWnd);

implementation

var hThinFont: hFont;

function SetFont(dlg: hWnd; lParam: longint): boolean; export;
begin
  SendMessage(dlg,WM_SETFONT,lParam,longint(FALSE));
  SetFont := TRUE;
end;

procedure SetThinDlgFont(dlg: hWnd);
begin
  EnumChildWindows(dlg,@SetFont,hThinFont);
end;

begin
  hThinFont := GetStockObject(ANSI_VAR_FONT);
end.
 

> - How do I display a dialog located in a resource file, and how do I get
> the data the user has entered in the dialog (for example, which
> checkboxes are checked, or a text string the user has entered, or
> whatever).

To load load a dialog resource:
DialogBox(), or CreateDialog()

To set/get input box text:
SetDlgItemText(), GetDlgItemText()
SetDlgItemInt(), GetDlgItemInt()
CheckDlgButton(), CheckRadioButton(), IsDlgButtonChecked()

The online help tells you more.

Andras

On Mon, 25 Jan 1999 23:02:45 +0800, "Paul Cesar C. Razon"
<yumyum@cdo.weblinq.com> wrote:

>Delphi v1.0

Okay, I think we've finally got everything straightened out.

If you try the original code in a Delphi 1.0 program, you'll find that
it _does_ work, but only for DOS programs. It doesn't work for Windows
programs because Win95 implements a multitasking model. You can
achieve a similar effect for 16-bit Windows programs by locking the
volume, using this pair of functions:

procedure LockPhysicalVolume(Drive: Char);
var
  Rslt: Boolean;
  Code: Byte;
begin
asm
  mov ax,$440D
  xor bx,bx
  mov bl,Drive
  and bl,$5F
  sub bl,'A'
  mov cx,$084B
  xor dx,dx
  int $21
  lahf
  and ah,$01
  xor ah,$01
  mov Rslt,ah
  mov Code,al
  end;
if not Rslt then begin
  InOutRes := Code;
  DefaultExceptHandler(100, @LockPhysicalVolume);
  end;
end;

procedure UnlockPhysicalVolume(Drive: Char);
var
  Rslt: Boolean;
  Code: Byte;
begin
asm
  mov ax,$440D
  xor bx,bx
  mov bl,Drive
  and bl,$5F
  sub bl,'A'
  mov cx,$086B
  xor dx,dx
  int $21
  lahf
  and ah,$01
  xor ah,$01
  mov Rslt,ah
  mov Code,al
  end;
if not Rslt then begin
  InOutRes := Code;
  DefaultExceptHandler(100, @UnlockPhysicalVolume);
  end;
end;

-Steve

Here's an example I found on Delphi's WebSite.

http://www.inprise.com/delphi/deltips/1999/tip010499.html

Basically, this should steer you in the correct direction.  It shows
you how to redirect the input, output and error handles for running a
DOS application.  You create a process for it and wait for it to
finish.  The output is written to a file, which you can use to see the
results.  The way the example is written, the DOS window is not
displayed.

I've used this example myself, but modified it so I could use
temporary Windows files instead of existing files, which I think this
example expects (at least for input or output).  Plus using TStrings
to pass input/output around.

Hope this helps,
Ed

On 25 Jan 1999 18:10:28 GMT, "Mirco Schmedicke" <1036-734@online.de>
wrote:

>Thanks for your help, but this is not exactly what I want!
>
>I have an (old) DOS-program with 20 parameters. And I want to write a shell
>which will start this program for me. That is no problem, but I want to see
>the output, the DOS-program sends to the DOS-screen. To show the DOS-screen
>itself is no problem, too, but this an unprofessional solution for my
>problem :-(

Wed 27-Jan-99: PCs faster than 200Mhz have brought along a new
problem with some old programs. Turbo Pascal's Crt screen handling
cease to work because of a "divide by 0" initialization error. This
problem only concerns Turbo Pascal 7.0, not the earlier TP versions.
I have therefore made an update

 117179 Jan 27 12:34 ftp://garbo.uwasa.fi/pc/ts/tspa357c.zip
 tspa357c.zip Turbo Pascal 7.0 real mode units for (real:-) programmers.

My compliments and thanks to Osmo Ronkanen for solving this awkward
Crt problem with the FDelay unit. For more about the FDelay unit
please see #124 in the ftp://garbo.uwasa.fi/pc/link/tsfaqp.zip Turbo
Pascal FAQ.

   All the best, Timo

Prof. Timo Salmi   Co-moderator of news:comp.archives.msdos.announce
-------
TP-links "patches"

so, nachdem ich neulich das Problem hatte, dass das GetAvailableComPorts
aus der CKB nicht unter NT lief, hab ich endlich den Fehler gefunden.
Und zwar heissen die Eintraege in der Registry bei NT nicht COM1, COM2
usw. wie bei Win95, sondern sinnigerweise serial0, serial1 etc..., die
Werte darin lauten jedoch bei beiden Systemen gleich ("COM1", "COM2",...).
Ich hab nun die Routine GetAvailableComPorts umgestrickt und moechte sie
hier posten, damit andere vielleicht auch davon profitieren koennen. Due
Funktion liefert als String eine Liste aller Com-Ports zurueck, also
z.B. "COM1,COM2,COM3". Somit kann mit einem einfachen
if Pos('COM1',GetAvailableComPorts)>0
abgefragt werden, ob es z.B. COM1 gibt.

Viel Spass,
Dietmar

function GetAvailableComPorts : string;
var Reg      : TReg;
    i        : integer;
    s, t     : string;
    ComPorts : TStrings;
begin
     s        := '';
     Reg      := TReg.Create;
     ComPorts := TStringList.Create;
     Reg.RootKey := HKEY_LOCAL_MACHINE;
     if Reg.OpenKey('hardware\devicemap\SerialComm',false) then
     begin
        Reg.GetValueNames(ComPorts);
        if ComPorts.Count>0 then
        begin
             for i:=0 to ComPorts.Count-1 do
             begin
                  t := Reg.ReadString(ComPorts.Strings[i]);
                  s := s + t + ',';
             end;
             Delete(s,Length(s),1);
        end;
     end;
     GetAvailableComPorts := s;
     ComPorts.Free;
     Reg.Free;
end;

Hallo Stefan,

Am 27.01.99 schrieb s.schmitt an
zum Thema "TImage bzw. BMP drucken ?" folgende Zeilen:

> kennt jemand einen Trick oder eine Komponente für Delphi 1,
> mit der man ein TImage bzw. BMP-Files ausdrucken kann ?

-------------------------Elektronische-Beisskante-------------------------

Verwenden von StretchDIBits statt Draw für das Drucken von Bitmaps
------------------------------------------------------------------
Wenn Sie eine Bitmap drucken, vergewissern Sie sich, daß die Windows API-
Routine StretchDIBits verwenden. Im folgenden finden Sie ein Beispiel, das
eine beliebige TBitmap an der angegebenen X,Y-Stelle druckt:

  procedure PrintBitmap(Bitmap: TBitmap; X, Y: Integer);
  var
    Info: PBitmapInfo;
    InfoSize: Integer;
    Image: Pointer;
    ImageSize: Longint;
  begin
    with Bitmap do
    begin
      GetDIBSizes(Handle, InfoSize, ImageSize);
      Info := MemAlloc(InfoSize);
      try
        Image := MemAlloc(ImageSize);
        try
          GetDIB(Handle, Palette, Info^, Image^);
          Printer.BegindDoc;
          with Info^.bmiHeader do
            StretchDIBits(Printer.Canvas.Handle, X, Y, Width,
              Height, 0, 0, biWidth, biHeight, Image, Info^,
              DIB_RGB_COLORS, SRCCOPY);
        finally
          Printer.EndDoc;
          FreeMem(Image, ImageSize);
        end;
      finally
        FreeMem(Info, InfoSize);
      end;
    end;
  end;

-------------------------Elektronische-Beisskante-------------------------

> Ich hab mir bei allen großen Web-Archives den Rüssel wund
> gesucht, aber anscheinend ist das eine der wenigen Sachen,
> die es nicht an jeder Ecke gibt :-)

Diese Prozedur wird bei Delphi 1.0 sogar in einer
Readme-Datei mitgeliefert, allerdings gut versteckt :-)

 Gruss     Ralph
E-Mail: welz@stud.uni-frankfurt.de         Fidonet: 2:244/1351.66
        R.Welz@t-online.de
http://home.t-online.de/home/R.Welz

In article <793dg1$bsq@loisto.uwasa.fi>, Timo Salmi <ts@UWasa.Fi> wrote:
>
>Let's pause here for a moment. We indeed have the various solutions
>for the RTE200 problem when the source code is available. The
>current question, however, seems somewhat a different variation. Is
>there anything a user can do for just an .exe or a .tpu unit with
>this problem? At least our TP FAQ #124 does not yet mention anything
>on this twist. The only solution I can thing of off-hand are the
>slowdown programs.

How about this: Tfix.pas. It is used as a loader program: Tfix program
parameters. As one can see it is derived from the fdelay unit. However,
accurate delay cannot be reproduced, instead maximum value: 65535 is
used for the delay loop. It requires TP 6.0+ to compile.

{$M 1100,0,0}

Program TFix;

uses dos;  { better not use CRT :-) }
 

procedure oldints; assembler; { "variables" in the code segment }
          asm dd 0,0; db 0 end;
 
 

Procedure Int0; assembler;
          asm
          cmp byte ptr oldints+8,0     { Done with the fix? }
          jnz @old

          cmp cx,55       { If CX<>55 we are at some other point }
          jne @x
          cmp dx,cx       { If DX<CX we are at some other point }
          jae @ok

@x:       mov byte ptr oldints+8,1     { unexpected division overflow }
                                       { we are done with the fix }

@old:     jmp dword ptr oldints

@ok:
          mov dx,54                    { slowest possible delay }
          mov ax,65535
          mov byte ptr oldints+8,1     { we are done with the fix }
          iret                         { return to the DIV (286+) }
          end;
 
 

Procedure Int21h; assembler;
          asm
          cmp byte ptr oldints+8,0
          jnz @old

          cmp ax,$2500
          jne @x
          mov word ptr oldints,dx
          mov word ptr oldints+2,ds
          iret

@x:
          cmp ax,$251B
          jne @old                      { Not setint 1Bh? }
          mov byte ptr oldints+8,1      { inactivate! }
 

@old:     jmp dword ptr oldints+4

          end;
 

type tr=record int0,int21:pointer; flag:byte End;
     pr=^tr;

     ps=^string;

var i,j:integer;
    cline:string[128];
    pname:pathstr;
    i21save,i00save:pointer;

    int:array[0..255] of pointer absolute 0:0;

begin
  cline:=ps(ptr(prefixseg,128))^;
  while (cline<>'') and (cline[1]=' ') do delete(cline,1,1);

  i:=1;
  while (i<=length(cline)) and (cline[i]<>' ') do inc(i);
  pname:=copy(cline,1,i-1);
  for j:=1 to length(pname) do pname[j]:=upcase(pname[j]);
  j:=length(pname);
  while (j>0) and not (pname[j] in ['\','/','.']) do dec(j);
  if (j=0) or (pname[j]<>'.') then  pname:=pname+'.EXE';
  pname:=fsearch(pname,getenv('path'));

  if pname<>'' then begin
     swapvectors;

     GetIntVec(0,i00save);
     GetIntVec($21,i21save);

     with pr(@oldints)^ do begin
       int0:=i00Save;
       int21:=i21save;
       flag:=0;
     End;

     SetIntVec(0,@int0);
     SetIntVec($21,@int21h);

     exec(pname,copy(cline,i,255));

     SetIntVec($21,i21Save);     { Note the order, int 21h first so }
     SetIntVec(0,i00Save);       { it does not catch the setting of int 0}

     swapvectors;
  end
  else begin
         Writeln('TFix: Error: program not found');
         Writeln('Usage: TFix program [parameters]')
       End;

end.

The following program can be used to patch the programs. If one gives
just the name of the program as parameters,. it will give a temporary
fix but in that case delays should work OK. The patch should be good for
about 5 years. If one gives also parameter /nd then the delays will be set
to zero. This fixes the program for good and should also also with PM.

If one chooses first option then the program can be patched again after some
time or by explicitly specifying the factor. If one fixes with /nd it
cannot be reversed. Make backups and keep them.

{$n-}
Program Dfix;

uses dos;

Var buff:array[1..32768] of byte;
 

Var factor:1..1191;

const Division:array[1..10] of integer=
               ($f7,$d0,$f7,$d2,$B9,-1,-1,$f7,$f1,$a3);
 

      delay:array[1..19] of integer=($8e,6,-1,-1,$33,$ff,$26,$8a,$1d,
                                     $a1,-1,-1,$33,$d2,$e8,5,0,$e2,$f6);
 

      newdelay:array[1..19] of byte=($33,$ff,$8e,$c7,$26,$8a,$1d,
                                     $b8,0,0,$f7,$26,0,0,$e8,5,0,$e2,$f4);

      fixeddelay:array[1..19] of integer=($33,$ff,$8e,$c7,$26,$8a,$1d,$b8,
                                          -1,-1,$f7,$26,-1,-1,$e8,5,0,$e2,$f4);
 

      delayloop:array[1..14] of integer=($2d,1,0,$83,$da,0,$72,5,$26,
                                         $3a,$1d,$74,$f3,$c3);
 

Procedure Backup(st:string);
var fp,fp2:file;
    s:string[4];
    d:dirstr;
    n:namestr;
    e:extstr;
    i:integer;
    bytesread:word;
    t:longint;
begin
  fsplit(st,d,n,e);
  {$i-}
  for i:=1 to 999 do begin
    str(1000+i:3,s);
    delete(s,1,1);
    assign(fp,d+n+'.'+s);
    reset(fp,1);
    if ioresult>0 then break;
    close(fp);
    if ioresult>0 then;
  End;
  {$i+}
  assign(fp,d+n+'.'+s);
  rewrite(fp,1);
  assign(fp2,st);
  reset(fp2,1);
  repeat
    blockread(fp2,buff,sizeof(buff),bytesread);
    blockwrite(fp,buff,bytesread);
  until bytesread=0;
  getftime(fp2,t);
  setftime(fp,t);
  close(fp);
  close(fp2);
End;

var ind:longint;
    i,j:integer;
    bytesread:word;
    fp:file;
Function Find(data:array of integer):longint;
var ind:longint;
label out;
Begin
  ind:=0;
  repeat
    seek(fp,ind);
    blockread(fp,buff,sizeof(buff),bytesread);
    i:=1;
    while i<bytesread-20 do begin
      if buff[i]=data[0] then begin
         for j:=1 to high(data) do if (data[j]>=0) and (buff[i+j]<>data[j])
             then goto out;
         Find:=ind+i-1;
         exit;
      End;
   out:
     inc(i);
    End;
    inc(ind,bytesread-50);
 until bytesread<=50;
 find:=-1;
End;

Procedure Error;
begin
  Writeln('Dfix: Could not find CRT unit!"');
  close(fp);
  halt;
End;

Procedure FixNoDelay;
var x:byte;
    ind:longint;
Begin
  ind:=find(Delayloop);
  if ind<0 then error;
  x:=$c3;
  Seek(fp,ind);
  blockwrite(fp,x,1);
End;

Procedure FixDelay;
var ind,ind2,countindex:longint;
    xx:word;
Begin
  ind:=Find(Division);
  if ind<0 then error;
  ind2:=Find(Delay);
  Countindex:=ind2+10;
  if ind2<0 then begin
      ind2:=Find(FixedDelay);
      if ind2<0 then error;
      countindex:=ind2+12;
  End;

  if factor=1191 then xx:=65535
                 else xx:=55*factor;

  seek(fp,countindex);
  blockread(fp,newdelay[13],2);

  seek(fp,ind+5);
  blockwrite(fp,xx,2);
  seek(fp,ind2);
  newdelay[9]:=lo(factor);
  newdelay[10]:=hi(factor);

  Blockwrite(fp,newdelay,sizeof(newdelay));
End;
 

var x:word;
    err:integer;
    d,m,y,dw:word;
    ps2:string[4];
    fr:real;
begin
  getdate(y,d,m,dw);
  fr:=10*exp((y-1998)/1.5*ln(2));       { Moore's law }
  if fr>1191 then factor:=1191
             else factor:=trunc(fr);
  filemode:=2;
  if paramcount<1 then runerror(255);
  assign(fp,paramstr(1));
  backup(paramstr(1));
  reset(fp,1);
  val(paramstr(2),x,err);
  if err=0 then factor:=x;
  ps2:=paramstr(2);
  for d:=1 to length(ps2) do ps2[d]:=upcase(ps2[d]);

  if (ps2='/ND') then begin
     FixNoDelay;
     Writeln('Program fixed by disabling delays');
  End
  else begin
          FixDelay;
          Writeln('Program fixed with factor ',factor);
       end;
  close(fp);
End.

Osmo
-----
More about the RTE200 CRT bug: TP-links patches

---

Get your own FREE HOMEPAGE