On or about 1 Jul 1998 13:32:49 GMT, Ron McGregor wrote:

>As I recall, the long file name system used in NT is totally different to
>that used in Windows95. Windows95 long file name structures are actually
>compatible with DOS because the shortened  version of the file name (the
>one with the tilde character ~) is stored right after the long version.
>WindowsNT long file names do not follow this procedure. I think that
>WindowsNT file system is more similar to OS/2 than to Windows95. I suspect
>that this could be why int21/7160h doesn't work under WindowsNT.
>

Has anyone bothered to find out yet what happens if you rename a file
to a longer name? Do all the files further on in the directory get
moved?

BTW, you can find the extra bits of long filenames in MS DOS 5 with
plain, oldfashioned 4Eh/4Fh calls by setting CX (the attributes)
appropriately (CX=0Fh iirc). You do have to decode them yourself, of
course.

--
Simon van Dongen <sgvd@xs4all.nl> Rotterdam, The Netherlands

As he reclined there he sang ballads of ancient valour, from
time to time beating a hollow wooden duck in unison with his
voice, so that the charitable should have no excuse for
missing the entertainment.  -Bramah, Kai Lung's Golden Hours

Hi,

Your variable S in local to your function (it is created within the stack),
so when you function exits, the memory for this var is freed an reused.
As i see you DLL is wrote using Delphi 1 (because or the export statement
and your string to PChar conversion). You're lucky, because stack of a 16
bits application is shared with his caller, but in 32 bits, Dll's have its
own stack...
Anyway, you cannot use stack to send back a data.

There is two solutions to your problem...
As you use a 16 bits Dll, you can make you S variable global (so its address
will be static) but i dont recommend this solution.
You should use a argumented PChar to send back data (it'll work both on 16
an 32 bits..)
Try :

function MakeKey(name, additional1, additional2, ANSWER: PChar): PChar;
export;
var s: String;
begin
    s := MakeVerySecretCode(StrPas(name));
    StrPCopy(ANSWER, s);
    Result := ANSWER;
end;

DO NOT FORGET TO ALLOCATE MEMORY FOR YOUR ANSWER PCHAR !!!

@+

Lorenz Graf a écrit dans le message
<6nbep9$s1h$5@freenet-b.fen.baynet.de>...
>Hello Delphi coders !
>My problem is:
>I want to build a DLL which contains a function that returns a pchar:
>  function MakeKey(name, additional1, additional2: PChar): PChar; export;
>Now I try to generate a result pchar e.g. by doing this:
>  function MakeKey(name, additional1, additional2: PChar): PChar; export;
>  var s: String;
>  begin
>       s := MakeVerySecretCode(StrPas(name));
>       s := s+#0;                { makes string null -terminated }
>       Result := @s[1];               { skip s[0], as it contains length }
>  end {MakeKey};
>However, all the time I call the function from my application, I get an
>access violation. So my questions are: How to avoid the Access Violation ?
>Where does the memory I allocate for the result get freed ? Does it get
>freed at all ??
>If you know about this, I would be very pleased to hear from you. If you
got
>a friend who is the DLL-Man, please give me his e-mail address.
>Greetings,
>Lorenz
>--
>please reply to LGraf@POBoxes.com
> and visit the HTMLtool homepage at
>http://www.poboxes.com/HTMLtool/
> rated 5 duckies at NoNags

Toby Cubitt wrote:
>
> What can you do in turbo pascal if you want to re-dimension an array
> based on user input.

{$A+,B-,D+,E-,F-,I-,L+,N-,O-,R-,S-,V-,T-}
{$DEFINE UNIT}
{$IFDEF UNIT}
Unit Plateau;

Interface
{$ENDIF}

Type
  IndexArray = Array[1..$3FFF] Of LongInt;
  SizeArray = Array[0..$3FFE] Of LongInt;
  PlatauObj = Object
         Base: Pointer;
   IndexTable: ^IndexArray;
    SizeTable: ^SizeArray;
          Dim: Word;

    Function Init (pDim,pSize: Word; Var pBound,pIndex): Boolean;
    Function GetAddr: Pointer;
    Procedure Help;
  End;

{$IFDEF UNIT}
Implementation
{$ENDIF}

Function Ptr2Long(p: Pointer): LongInt; Assembler;
Asm
   mov ax,word ptr [p+2]
   mov dx,ax
   shr dx,12
   shl ax,4
   add ax,word ptr [p]
   adc ax,0
End;

Function Long2Ptr(l: LongInt): Pointer; Assembler;
Asm
   mov ax,word ptr [l]
   mov dx,word ptr [l+2]
   mov bx,ax
   and ax,0Fh
   shr bx,4
   shl dx,12
   add dx,bx
End;

Function SubPtr(p: Pointer; d: LongInt): Pointer;
Begin
  SubPtr := Long2Ptr(Ptr2Long(p)-d);
End;

Function AddPtr(p: Pointer; d: LongInt): Pointer;
Begin
  AddPtr := Long2Ptr(Ptr2Long(p)+d);
End;

Function PlatauObj.Init (pDim, pSize: Word; Var pBound, pIndex):
Boolean;
Var Loop: Word; Disp: LongInt; Bound: Array[1..$1FFF,1..2] Of LongInt
Absolute pBound;
Begin
  {$IFOPT D+} FillChar (Self,SizeOf(Self),0); {$ENDIF}
  IndexTable := @pIndex;
  Dim := pDim;
  GetMem (SizeTable,SizeOf(LongInt)*Succ(pDim));
  SizeTable^ [pDim] := pSize;

  Disp := 0;
  For Loop := pDim DownTo 1 Do
  Begin
    Inc(Disp,SizeTable^[Loop]*Bound[Loop,1]);
    SizeTable^[Pred(Loop)] :=
SizeTable^[Loop]*Succ(Bound[Loop,2]-Bound[Loop,1]);
  End;

  If (MaxAvail < SizeTable^[0])
     Then Init := False
     Else
       Begin
         Init := True;
         Base := SubPtr(HeapPtr,Disp);
         HeapPtr := AddPtr(HeapPtr,SizeTable^[0]);
       End;
End;

Function PlatauObj.GetAddr: Pointer;
Var Loop: Word; Disp: LongInt;
Begin
  Disp := 0;
  For Loop := 1 To Dim Do
    Inc(Disp,SizeTable^[Loop] * IndexTable^[Loop]);
  GetAddr := AddPtr (Base,Disp);
End;

Procedure PlatauObj.Help;
Begin
  WriteLn;
  WriteLn ('Unit Plateau V1.2 - (C) by Antivivisektion@t-online.de,
Update: 3. Feb 1992');
  WriteLn ('Fields of dynamic dimensions and borders with size > 64 K');
  WriteLn;
  WriteLn ('1. Static version');
  WriteLn ('   Var Field: Array[-3..30,-4..40,-5..50] Of Real;');
  WriteLn ('   Begin');
  WriteLn ('     Field[-2,-3,-4] := PI;');
  WriteLn ('   End.');
  WriteLn;
  WriteLn ('2. Dynamic version');
  WriteLn ('   Uses Plateau;');
  WriteLn ('   Const DIM = 3;');
  WriteLn ('   Const Bound: Array[1..DIM,1..2] Of LongInt =
((-3,30),(-4,40),(-5,50));');
  WriteLn ('   Var Index: Array[1..DIM] Of LongInt; Field: PlatauObj;');
  WriteLn ('   Begin');
  WriteLn ('     If Not Field.Init (DIM,SizeOf(Real),Bound,Index) Then
RunError(203);');
  WriteLn ('     Index[1] := -2; Index[2] := -3; Index[3] := -4;');
  WriteLn ('     Real(Field.GetAddr^) := PI;');
  WriteLn ('   End.');
  WriteLn;
End;

{$IFNDEF UNIT}
Const DIM = 3;
Const Bound: Array[1..DIM,1..2] Of LongInt = ((-3,30),(-4,40),(-5,50));
Var Index: Array[1..DIM] Of LongInt; Field: PlatauObj; i: LongInt;
Begin
  If Not Field.Init (DIM,SizeOf(Real),Bound,Index) Then RunError(203);
  Index[1] := -2; Index[2] := -3; Index[3] := -4;
  Real(Field.GetAddr^) := PI;
{$ENDIF}
End.
A.E.Neumann für die Antivivisektion e.V., PO-Box 201, D-53569 Unkel
mailto:Antivivisektion@t-online.de http://Antivivisektion.base.org/

Hope this helps, it's not commented very well:

procedure TForm1.Button1Click(Sender: TObject);
var
  I:                         Integer;
  FileHandle:                Integer;

  V:                         Variant;

begin
  V:=CreateOleObject('Word.Basic');
  For I:=1 to 3 do begin
    FileHandle:=V.FileNew('d:\Alan\delphi projects\testole\TextB.dot');

    V.EditGoTo('Title');
    V.Insert('MyTitleIsHere-'+IntToStr(I)+'-');

V.FileSaveAs(Name:='d:\Alan\TestOLE-'+IntToStr(I)+'.doc',Format:=0,AddToMRU:=0);
    V.FileClose(FileHandle);
  end;

  ShowMessage('All done.');
end;
=======

Lee Davis wrote:
>
> Hi,
>
> I am trying to start Word, load a template and fill in fields in the Word
> document with fields from my database including a graphic, but having no
> success.
>
> Can someone please paste me code showing exactly how to do this please?
>
> Many thanks
> Lee

The following is a farily simple routine to determine if 2 line segments
intersect.  The only exception is if the 2 lines are co-linear.  I'll leave
this check for you to figure out.  I hope this will help you out.

Wayne

{----------------}
Type
  point =
     record
        x,y : integer;
     end;
   lne =
      record
        p1,p2 : point;
     end;

function intersect(L1,L2 : lne) : boolean;
  {checks to see if 2 points lie on the same side of a line or
    on opposite sides...if on opposite side, then intersection occurs and
returns true}

  var
    tb : boolean;
    s1,s2,dx,dy,dx1,dx2,dy1,dy2 : longint;

               {-----------------------------------------------}
               function same(l : lne;p1,p2 : point) : longint;
                 begin
                   dx  := l.p2.x - l.p1.x;
                   dy  := l.p2.y - l.p1.y;
                   dx1 := p1.x - l.p1.x;
                   dy1 := p1.y - l.p1.y;
                   dx2 := p2.x - l.p2.x;
                   dy2 := p2.y - l.p2.y;
                   same := (dx*dy1-dy*dx1)*(dx*dy2-dy*dx2);
                 end;
               {-----------------------------------------------}
  begin
    s1 := same(l1,l2.p1,l2.p2);
    s2 := same(l2,l1.p1,l1.p2);
    tb := (s1<=0) and (s2<=0);
    intersect := tb;
  end;{intersect}
{--------------}

In article <35B12503.3D29@virgin.Net>, Kenn <kenn.p@virgin.Net> writes:

>Hello.
>
>Ive written a routine to calculate the intersection of 2 lines, but
>as its not very fast I thought I pose the problem here rather than
>work on it any more myself ;)
>
>line 1 is defined as x1 y1 x2 y2 (all integer)
>line 2 is defined as sx sy a (start position and angle (0-2047 degrees)
>and of infinate length, and once again all integers.
>
>I dont really want to post the code itself here (its a bit of a mess
>having gone from pascal to asm in many separate stages and then after
>a _lot_ of optimising) but i will if anyone is interested.
>
>Basically the method I've used is to rotate line1 by -a.
>
>I also do a few checks to see if it is impossible for the lines to cross
>(ie impossible if (x2<sx) or (x1>sx) or ((y1>sy) and (y2>sy))
>and checked to see if line1's back is facing (x1>x2)

[snip]

I'd like to display a bitmap in the main MDI frame (the workspace where
the MDI childs are). Some kind of a logo...
I know this is possible with some WinAPI fonction, something low level
and which draws inside the very form.
I don't wanna use any component, for when you do this, it may not stay
at the middle of the MDI frame and I don't wanna bother with redrawing.
Does anybody have an idea ?
---------------------------
   Betreff: Re: Display a bitmap in a MDI frame...
     Datum: Thu, 20 Aug 1998 13:12:22 GMT
       Von: xavier@xapware.com (Xavier Pacheco (TeamB))
     Foren: borland.public.delphi.graphics

The following unit illustrates how to do this:

--- x

{Copyright © 1998 by Delphi 4 Developer's Guide - Xavier Pacheco and
Steve Teixeira

www.xapware.com/ddg}

unit MainFrm;

interface

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

type
  TMainForm = class(TForm)
    mmMain: TMainMenu;
    mmiFile: TMenuItem;
    mmiNew: TMenuItem;
    mmiClose: TMenuItem;
    N1: TMenuItem;
    mmiExit: TMenuItem;
    mmiImage: TMenuItem;
    mmiTile: TMenuItem;
    mmiCenter: TMenuItem;
    mmiStretch: TMenuItem;
    imgMain: TImage;
    procedure mmiNewClick(Sender: TObject);
    procedure mmiCloseClick(Sender: TObject);
    procedure mmiExitClick(Sender: TObject);
    procedure mmiTileClick(Sender: TObject);
  private
    FOldClientProc,
    FNewClientProc: TFarProc;
    FDrawDC: hDC;
    procedure CreateMDIChild(const Name: string);
    procedure ClientWndProc(var Message: TMessage);
    procedure DrawStretched;
    procedure DrawCentered;
    procedure DrawTiled;
  protected
    procedure CreateWnd; override;
  end;

var
  MainForm: TMainForm;

implementation

uses MdiChildFrm;

{$R *.DFM}

procedure TMainForm.CreateWnd;
begin
  inherited CreateWnd;
  // Turn the ClientWndProc method into a valid window procedure
  FNewClientProc := MakeObjectInstance(ClientWndProc);
  // Get a pointer to the original window procedure
  FOldClientProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
  // Set ClientWndProc as the new window procedure
  SetWindowLong(ClientHandle, GWL_WNDPROC, LongInt(FNewClientProc));
end;

procedure TMainForm.DrawCentered;
{ This procedure centers the image on the form's client area }
var
  CR: TRect;
begin
  GetWindowRect(ClientHandle, CR);
   with imgMain do
     BitBlt(FDrawDC, ((CR.Right - CR.Left) - Picture.Width) div 2,
            ((CR.Bottom - CR.Top) - Picture.Height) div 2,
            Picture.Graphic.Width, Picture.Graphic.Height,
            Picture.Bitmap.Canvas.Handle, 0, 0, SRCCOPY);
end;

procedure TMainForm.DrawStretched;
{ This procedure stretches the image on the form's client area }
var
  CR: TRect;
begin
  GetWindowRect(ClientHandle, CR);
  StretchBlt(FDrawDC, 0, 0, CR.Right, CR.Bottom,
             imgMain.Picture.Bitmap.Canvas.Handle, 0, 0,
             imgMain.Picture.Width, imgMain.Picture.Height, SRCCOPY);
end;

procedure TMainForm.DrawTiled;
{ This procedure tiles the image on the form's client area }
var
  Row, Col: Integer;
  CR, IR: TRect;
  NumRows, NumCols: Integer;
begin
  GetWindowRect(ClientHandle, CR);
  IR := imgMain.ClientRect;
  NumRows := CR.Bottom div IR.Bottom;
  NumCols := CR.Right div IR.Right;
  with imgMain do
    for Row := 0 to NumRows+1 do
      for Col := 0 to NumCols+1  do
        BitBlt(FDrawDC, Col * Picture.Width, Row * Picture.Height,
               Picture.Width, Picture.Height,
Picture.Bitmap.Canvas.Handle,
               0, 0, SRCCOPY);
end;

procedure TMainForm.ClientWndProc(var Message: TMessage);
begin
  case Message.Msg of
    // Capture the WM_ERASEBKGND messages and perform the client area
drawing
    WM_ERASEBKGND:
      begin
        CallWindowProc(FOldClientProc, ClientHandle, Message.Msg,
Message.wParam,
          Message.lParam);
        FDrawDC := TWMEraseBkGnd(Message).DC;
        if mmiStretch.Checked then
          DrawStretched
        else if mmiCenter.Checked then
          DrawCentered
        else DrawTiled;
        Message.Result := 1;
      end;
    { Capture the scrolling messages and ensure the the client area
      is redrawn by calling InvalidateRect }
    WM_VSCROLL, WM_HSCROLL:
      begin
        Message.Result := CallWindowProc(FOldClientProc, ClientHandle,
Message.Msg,
          Message.wParam, Message.lParam);
        InvalidateRect(ClientHandle, nil, True);
      end;
    else
    // By Default, call the original window procedure
      Message.Result := CallWindowProc(FOldClientProc, ClientHandle,
Message.Msg,
        Message.wParam, Message.lParam);
  end; { case }
end;

procedure TMainForm.CreateMDIChild(const Name: string);
var
  MdiChild: TMDIChildForm;
begin
  MdiChild := TMDIChildForm.Create(Application);
  MdiChild.Caption := Name;
end;

procedure TMainForm.mmiNewClick(Sender: TObject);
begin
  CreateMDIChild('NONAME' + IntToStr(MDIChildCount + 1));
end;

procedure TMainForm.mmiCloseClick(Sender: TObject);
begin
  if ActiveMDIChild <> nil then
    ActiveMDIChild.Close;
end;

procedure TMainForm.mmiExitClick(Sender: TObject);
begin
  Close;
end;

procedure TMainForm.mmiTileClick(Sender: TObject);
begin
  mmiTile.Checked := false;
  mmiCenter.Checked := False;
  mmiStretch.Checked := False;
  { Set the Checked property for the menu item which invoked }
  { this event handler to Checked                            }
  if Sender is TMenuItem then
    TMenuItem(Sender).Checked := not TMenuItem(Sender).Checked;
  { Recraw the client area of the form }
  InvalidateRect(ClientHandle, nil, True);
end;

end.

==============================
Xavier Pacheco (TeamB)
xavier@xapware.com

Sorry but TeamB cannot answer support
questions received via email.

Hallo Herr Glaser,

Nach dem Studium der mitgelieferten Beispiele in BPW7.0 habe ich das Problem nun
anscheinend lösen können; alle Blt-Operationen mit dem Handle der Bitmap funktionieren
anscheinend nur mit dem Bildschirm-DC?! Wenn ich jedoch die Funktion die mir das
Handle zum Drucken vergewaltige (mit SetDIBitsToDevice(Hunderttausendparameter)
funktioniert das. SetDIBitsToDevice muß den (Drucker)treiber des DC verwenden, so daß
die ganze Sache auch auf´s Papier kommt. Dankschreiben an Herrn Gates, für mich gehört
in die API eine Funktion DrawBitmap(DC:HDC; FileName:PChar; XPos, YPos, Vieleicht noch
Streck und Stauch und meinetwegen Farbpalette).

Ich hoffe Ihnen damit geholfen zu haben.:->

Karsten Krieger
KUSEDV@Evolution.org

----------------------------
function LoadBitmapFile(FileName: PChar; DC:HDC): HBitmap;

var
  F: Integer;                   { File Handle for Windows file functions }
  H: THandle;                   { Handle to memory for bitmap }
  Size, N: Longint;             { Size of bitmap, Size of color spec }
  P: PBitmapInfo;               { Windows bitmap format info header }
  Header: TBitmapFileHeader;    { Bitmap file header }

begin
  LoadBitmapFile := 0;
  F := _LOpen(FileName, of_Read);
  if F = -1 then Exit;

  { read in the Bitmap file header }
  if (_LRead(F, @Header, SizeOf(Header)) <> SizeOf(Header)) or
    (Header.bfType <> BMType) then
  begin
    _LClose(F);
    Exit;
  end;

  { read the rest of the file }
  Size := _LFileSize(F) - SizeOf(TBitmapFileHeader);
  H := GlobalAlloc(gmem_Moveable, Size);        { Allocate the memory }
  if H = 0 then
  begin
    _LClose(F);
    Exit;
  end;

  P := GlobalLock(H);                           { Lock it down }

  if (HugeIO(_LRead, F, P, Size) <> 0) and
    (P^.bmiHeader.biSize = SizeOf(TBitmapInfoHeader)) then
  begin
    { Compute the offset from the beginning of P^ }
    { where the actual image begins }
    N := Header.bfOffBits - SizeOf(TBitmapFileHeader);

    { actually create the Bitmap }
    LoadBitmapFile := CreateDIBitmap(DC, P^.bmiHeader,
      cbm_Init, Ptr(PtrRec(P).Hi,N),P^, dib_RGB_Colors);
  end;

  {------------------------------> Print Bitmap to DC <------------------------------------}

  SetDIBitsToDevice(DC,
    10, 10, P^.bmiHeader.biWidth, P^.bmiHeader.biHeight, 0, 0, 0, 100,
    Ptr(PtrRec(P).Hi,N), P^, DIB_RGB_Colors);

  {------------------------------> Print Bitmap to DC <------------------------------------}

  GlobalUnlock(H);
  GlobalFree(H);
  _LClose(F);
end;

david_echavarria@my-dejanews.com wrote:
: I need to know how to program the execute instruction in
: turbo pascal version 3.0.

        This is what I use, haven't had any trouble.

Joe Fischer

{.F-}
{
Executes any DOS or external command from within Turbo Pascal.
Call as EXECUTE CommandString
CommandString may be any DOS INTERNAL, Batch, COM or EXE command
  and may include command line arguments.
Note that the PATH is automatically searched
  for any external program files.

IMPORTANT: Compile with min heap = $200/ max heap = $200.

The procedure execute_string may be incorporated into any Turbo program.
it is the responsibility of the host program to deallocate sufficient
memory above itself for the external command to execute.

************************WARNING*******************************
*    this technique uses undocumented features of MSDOS.     *
*    It appears to work on all versions of MSDOS (2.X-3.1),  *
*    but since it is undocumented it may not always work.    *
**************************************************************

written by Russ Nelson, Potsdam, NY.
small modifications and uploaded by Kim Kokkonen, 72457,2131.

Other Mods Kerry Kirsch 70176,576 - Shut off Interrupts when messing with
the stack aviod potential big crash. Also ***WARNING*** It appears that this
procedure will close all files open with File Handles, (not files opened
with file control blocks). Also, nested calls of the procedure results in
free memory getting gobbled up. i.e. - Execut c:\Execut dir.
}
{.F+}

PROGRAM Execute;
TYPE
  str255 = STRING[255];
VAR
  commandline : str255 ABSOLUTE CSeg : $80;

  PROCEDURE execute_string(s : str255);
    { execute_string -- execute a command line }
  VAR
    save_ax : Integer;
  CONST
    save_ss : Integer = 0;
    save_sp : Integer = 0;
  BEGIN
    s[Length(s)+1] := ^M;
    INLINE(
      $1E/                    {   push    ds                   }
      $55/                    {   push    bp                   }
      $2E/$8C/$16/save_ss/    {   mov     cs:[save_ss],ss      }
      $2E/$89/$26/save_sp/    {   mov     cs:[save_sp],sp      }
      $8C/$D0/                {   mov     ax,ss                }
      $8E/$D8/                {   mov     ds,ax                }
      $8D/$76/<s/             {   lea     si,s[bp]             }
      $CD/$2E/                {   int     2eh                  }
      $FA/                    {   cli                          }
      $2E/$8E/$16/save_ss/    {   mov     ss,cs:[save_ss]      }
      $2E/$8B/$26/save_sp/    {   mov     sp,cs:[save_sp]      }
      $FB/                    {   sti                          }
      $5D/                    {   pop     bp                   }
      $1F/                    {   pop     ds                   }
      $89/$46/<save_ax        {   mov     save_ax[bp],ax       }
      );
    IF save_ax <> 0 THEN WriteLn('Exit code = ', save_ax);
  END;

BEGIN
  IF Length(commandline) > 0
  THEN execute_string(commandline)
  ELSE execute_string('dir/w');
END.

Thanks to various inputs from Franz Glaser, JKe7306087 and Ulli Conrad
(Coder's Base), I solved my problem of setting NumLock, CapsLock and
ScrollLock on all 3 platforms:

Real mode:
  Mem[$0040:$17]:=Mem[$0040:$17] or $20;         {NumLock ON}
  Mem[$0040:$17]:=Mem[$0040:$17] and (not $20);  {NumLock OFF}
    {NumLock: $20, ScrollLock: $10, CapsLock: $40}

Protected mode:
  Mem[Seg0040:$17]:=Mem[Seg0040:$17] or $20;

Windows:
  uses WinProcs, WinTypes;  {also Win31 for VK_SCROLL}
  var KeyState: TKeyboardState;
  begin
    GetKeyboardState(KeyState);
    KeyState[VK_NUMLOCK]:=#1;           {#0: OFF, #1: ON}
    SetKeyboardState(KeyState);
  end.
    {VK_CAPITAL for CapsLock, VK_SCROLL for ScrollLock}

Took me some time to find out that VK_SCROLL also needs the Win31 unit !!

Thanks again.
___________
Olivier Avenel  SPEC / CEA-Saclay   91191 Gif-sur-Yvette Cedex  France
avenel@spec.saclay.cea.fr

"Stephane Landry" <landrys@grics.qc.ca> wrote:

>Hi,
>
>I use in my program in Turbo pascal version 6 the variable "FILEMODE" to
>open files in ReadOnly mode,
>
>I search How I can do the same in the Turbo Pascal version 3.  I know that
>the variable "FILEMODE" does not exist but if you know a way to do the same
>help me please....

I love a challenge.  In this case it helps to have reversed
engineered a copy of Turbo 3.01a as an exercise for learning
x86 assembly. ;-)

You'll have to zap the library's openfile mov AX,3D02h
instruction used for opening typed and untyped files.  That's
the technical side.

The not so technical instructions are to compile and run the
following ditty.  If it beeps "Eureka!", then you can define
VAR FileMode: Byte absolute CSEG:$24FC;  Otherwise let me know
the three hex digits it prints and we'll try again.

    ...red

TYPE Str2 = String[2];
VAR x: Array[0..2] of byte absolute Cseg:$24FB;

Function Hex(x: Byte): Str2;
CONST H: Array[0..15] of Char = '0123456789ABCEDF';
Begin
    Hex := h[x shr 4] + h[x and $F];
End;

BEGIN
    If (x[0] = $B8) and (x[1] = $02) and (x[2] = $3D) Then
       Writeln('Eureka!'#7)
    Else Writeln(Hex(x[0]), ' ', Hex(x[1]), ' ',Hex(x[2]))
END.
 
 

   Betreff: Re: TurboPascal 6 fonction Not in TP3
     Datum: Fri, 25 Sep 1998 03:11:26 GMT
       Von: rdonais@leading.net (R.E.Donais)
      Firma:Southeast Network Services, Inc.
      Foren:comp.lang.pascal.borland
 

Stephane and I resolved the problem through email.  I was working
with a PC-DOS 3.01A version of TP and she had an earlier PC-DOS
3.00B version.  The 3-byte instruction in the earlier version is
located at $248C so filemode for the two versions can be defined
as:

{VERSION 3.00B} VAR FileMode: Byte absolute CSEG:$248D;
{VERSION 3.01A} VAR FileMode: Byte absolute CSEG:$24FC;

    ...red

In <35f975a4.0@d2o206.telia.com>, "AGH" <arnt.gustav.haagensen@nt.telia.no> writes:
>The DRIVERS.TPU "unit"  is included on TP disks.
>
>I am looking for the  source code for ...
>  Procedure FormatStr(String, String, Pointer);
>
>Does any one have the source code for the DRIVERS.TPU file or
>the FormatStr procedure ???
>
>Best  Regards
>AGH
>arnt.gustav.haagensen@nt.telia.no
>

This is from our Free Vision project

{---------------------------------------------------------------------------}
{  FormatStr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 13Aug98 LdB         }
{---------------------------------------------------------------------------}
PROCEDURE FormatStr (Var Result: String; CONST Format: String; Var Params);
TYPE TLongArray = Array[0..0] Of LongInt;
VAR ResultLength, FormatIndex, Justify, Wth: Byte; Fill: Char; S: String;

   FUNCTION LongToStr (L: Longint; Radix: Byte): String;
   CONST HexChars: Array[0..15] Of Char =
    ('0', '1', '2', '3', '4', '5', '6', '7',
     '8', '9', 'A', 'B', 'C', 'D', 'E', 'F');
   VAR I: LongInt; S: String; Sign: String[1];
   BEGIN
     LongToStr := '';                                 { Preset empty return }
     If (L < 0) Then Begin                            { If L is negative }
       Sign := '-';                                   { Sign is negative }
       L := Abs(L);                                   { Convert to positive }
     End Else Sign := '';                             { Sign is empty }
     S := '';                                         { Preset empty string }
     Repeat
       I := L MOD Radix;                              { Radix mod of value }
       S := HexChars[I] + S;                          { Add char to string }
       L := L DIV Radix;                              { Divid by radix }
     Until (L = 0);                                   { Until no remainder }
     LongToStr := Sign + S;                           { Return result }
   END;

   PROCEDURE HandleParameter (I : LongInt);
   BEGIN
     While (FormatIndex <= Length(Format)) Do Begin   { While length valid }
       While (Format[FormatIndex] <> '%') AND         { Param char not found }
       (FormatIndex <= Length(Format)) Do Begin       { Length still valid }
         Result[ResultLength+1] := Format[FormatIndex]; { Transfer character }
         Inc(ResultLength);                           { One character added }
         Inc(FormatIndex);                            { Next param char }
       End;
       If (FormatIndex < Length(Format)) AND          { Not last char and }
       (Format[FormatIndex] = '%') Then Begin         { '%' char found }
         Fill := ' ';                                 { Default fill char }
         Justify := 0;                                { Default justify }
         Wth := 0;                                    { Default 0=no width }
         Inc(FormatIndex);                            { Next character }
         If (Format[FormatIndex] = '0') Then
           Fill := '0';                               { Fill char to zero }
         If (Format[FormatIndex] = '-') Then Begin    { Optional just char }
           Justify := 1;                              { Right justify }
           Inc(FormatIndex);                          { Next character }
         End;
         While ((FormatIndex <= Length(Format)) AND   { Length still valid }
         (Format[FormatIndex] >= '0') AND
         (Format[FormatIndex] <= '9')) Do Begin       { Numeric character }
           Wth := Wth * 10;                           { Multiply x10 }
           Wth := Wth + Ord(Format[FormatIndex])-$30; { Add numeric value }
           Inc(FormatIndex);                          { Next character }
         End;
         If ((FormatIndex <= Length(Format)) AND      { Length still valid }
         (Format[FormatIndex] = '#')) Then Begin      { Parameter marker }
           Inc(FormatIndex);                          { Next character }
           HandleParameter(Wth);                      { Width is param idx }
         End;
         If (FormatIndex <= Length(Format)) Then Begin{ Length still valid }
           Case Format[FormatIndex] Of
             'c': S := Char(TLongArray(Params)[I]);  { Character parameter }
             'd': S := LongToStr(TLongArray(Params)[I],
               10);                                   { Decimal parameter }
             's': S := PString(TLongArray(Params)[I])^;{ String parameter }
             'x': S := LongToStr(TLongArray(Params)[I],
               16);                                   { Hex parameter }
           End;
           Inc(FormatIndex);                          { Next character }
           If (Wth > 0) Then Begin                    { Width control active }
             If (Length(S) > Wth) Then Begin          { We must shorten S }
               If (Justify=1) Then                    { Check right justify }
                 S := Copy(S, Length(S)-Wth+1, Wth)   { Take right side data }
                 Else S := Copy(S, 1, Wth);           { Take left side data }
             End Else Begin                           { We must pad out S }
               If (Justify=1) Then                    { Right justify }
                 While (Length(S) < Wth) Do
                   S := S+Fill Else                   { Right justify fill }
                 While (Length(S) < Wth) Do
                   S := Fill + S;                     { Left justify fill }
             End;
           End;
           Move(S[1], Result[ResultLength+1],
             Length(S));                              { Move data to result }
           ResultLength := ResultLength + Length(S);  { Adj result length }
         End;
       End;
     End;
   END;

BEGIN
   ResultLength := 0;                                 { Zero result length }
   FormatIndex := 1;                                  { Format index to 1 }
   HandleParameter(0);                                { Handle parameter }
   Result[0] := Chr(ResultLength);                    { Set string length }
END;

Allen,

Take a look at this

Function GetNovellUserName : TStrg;

Type ObjectStr = String[47];
     Str15     = string[15];

     DayOfTheWeek     = (Sunday,Monday,Tuesday,Wednesday,Thursday,
                         Friday,Saturday);

     NovDateType      = record
                         Year,                     {80=1980}
                         Month,
                         Day,
                         Hour,
                         Minute,
                         Second     : Byte;
                         WeekDay    : DayOfTheWeek;
                         Filler     : Byte;
                        end;
 

     ConnInfoType     = record
                          ObjectID   : LongInt;     {the logged in object's
ID}
                          ObjectType : Word;        {the logged object's
type}
                          ObjectName : String[48];  {the name of the object}
                          LoginDate  : NovDateType; {the time/date the
object}
                                                 {logged on to connection}
                        end;
 
 

function NetWareLoaded(var LoggedOn : Boolean) : Boolean;
{-Returns TRUE if NetWare shell is loaded}
var
  NovRegs : Registers;

  Request : record
              Len    : Word;
              SubF   : Byte;
            end;

  Reply   : record
              Len    : Word;
              Access : Byte;
              ID     : LongInt;
            end;

begin
  FillChar(Reply,SizeOf(Reply),0);
  Reply.Len := 5;

  with Request do begin
    Len := 1;
    SubF := $46;
  end;

  with NovRegs do begin
    AH := $E3;
    DS := Seg(Request);  {DS:SI points to request}
    SI := Ofs(Request);
    ES := Seg(Reply);    {ES:DI points to reply}
    DI := Ofs(Reply);
    MsDos(NovRegs);      {MsDos = Intr $21}
    with Reply do begin
      NetWareLoaded := (AL=0) and (ID <> 0);
      LoggedOn      := (AL=0) and ((ID <> 0) and (ID <> -1));
    end;
  end;
end;
 
 
 

function GetConnNo : Byte;
{ returns connection number of requesting WS (1..MaxConnections) }

var
  NovRegs          : Registers; { register type for DOS/Novell calls }

begin
  {Novell function DCh subfunc 0}
  with NovRegs do
    AX := $DC00;
  MsDos(NovRegs);    {MsDos = Intr $21}
  GetConnNo := NovRegs.AL   {connection number from AL}
end;
 

function AsciiZ2Str(var Buffer; Max : Byte) : String;

const
  AsciiZMAX        = 255;

type
  AsciiZBuffer     = Array[1..AsciiZMAX] of Char;

var
  A                : AsciiZBuffer absolute Buffer;
  I                : Word;
  S                : String;

begin
  I := 1;
  { search for terminating #0, stop if max string length exceeded}
  while (A[I] <> #0) and (I < Max) do begin
    S[I] := A[I];
    Inc(I);
  end;
  S[0] := Char(I-1);
  AsciiZ2Str := S  {return the string}
end;
 
 

Function NetwareSwapLongPB (Li : Longint) : Longint;

Var Result : Record
       AW : Word;
       BW : Word;
    End;

Begin
  Move(Mem[Seg(Li):Ofs(li)],Result.Aw,2);
  Move(Mem[Seg(Li):Ofs(li)+2],Result.Bw,2);

  {Of Move (Li,Result,4);}

  With Result Do
    Begin
      Aw:=Swap(Aw); {Swap Lo,Hi part of word}
      Bw:=Swap(Bw);
    End;

  {Letop hier wordt ook nog gewisseld}

  Move(Result.Bw,Mem[Seg(Li):Ofs(li)],2);
  Move(Result.Aw,Mem[Seg(Li):Ofs(li)+2],2);

  NetwareSwapLongPB:=Li;
End;
 
 

procedure GetConnInfo(ConnNo : Byte; var ConnInfo : ConnInfoType);
{Get information about the object logged on to a given connection. The
 information returned includes the object's ID, the object type, the
object's
 name, and the time and date it logged on to the connection.
}

var
  NovRegs          : Registers;
  Request          : record
                       Len     : Word;
                       SubF    : Byte;
                       Conn    : Byte;
                     end;

  Reply            : record
                       Len     : Word;
                       ID      : LongInt;
                       ObjType : Word;
                       ObjName : Array[1..48] of Char;
                       Time    : NovDateType;
                     end;
 

begin
  Reply.Len := SizeOf(Reply) - 2;      {!!.03}
  with Request do begin
    Len  := 2;
    SubF := $16;
    Conn := ConnNo;
  end;
  with NovRegs do begin
    AH := $E3;
    DS := Seg(Request);  {DS:SI points to request}
    SI := Ofs(Request);
    ES := Seg(Reply);    {ES:DI points to reply}
    DI := Ofs(Reply);
    MsDos(NovRegs);      {MsDos = Intr $21}
  end;

  with ConnInfo do begin
    ObjectID   := NetWareSwapLongPB(Reply.ID);
    ObjectType := Swap(Reply.ObjType);
    ObjectName := AsciiZ2Str(Reply.ObjName,48);
    LoginDate  := Reply.Time;
  end;
end;

function GetUserName : ObjectStr;

var
    ConnInfo : ConnInfoType;
    LoggedIn : boolean;

begin
  if NetwareLoaded(LoggedIn) and LoggedIn then
    begin
      GetConnInfo(GetConnNo, ConnInfo);
      GetUserName := ConnInfo.ObjectName
    end
  else GetUserName := ''
end;  { GetUserName }
 

Begin
  GetNovellUserName:=GetUserName;
End;

Get your own FREE HOMEPAGE