{***************************************************************}
{***               FVision Unit Version1.0                   ***}
{***                    蓝蚂蚁工作室                         ***}
{***************************************************************}
{***                    XMS支持单元                          ***}
{***************************************************************}
{$F+}
Unit FXmsDrv;
Interface
Uses
  Dos;
Const
  XmsCanUse:Boolean=False;

Const
  rxUser    = $01;
  rxEnd     = $02;
  rxUserEnd = $03;
  wxAppend  = $01;
  wxReWrite = $02;

Function TestXms:Boolean;
Function GetXmsSize:Word;
Function MallocXms(Size:Word):Word;
Function FreeXms(Handle:Word):Boolean;
Function MoveXms(TPtr:Pointer;THandle:Word;SPtr:Pointer;SHandle:Word;Length:Longint):Word;
Function ReadFileToXms(Name:PathStr;Pos,Length:Longint;Mode:Byte):Word;
Procedure WriteXmsToFile(Handle:Word;Name:PathStr;Pos,Length:Longint;Mode:Byte);
Implementation
{$L XMS.OBJ}
Function TestXms:Boolean;external;
Function GetXmsSize:Word;external;
Function MallocXms(Size:Word):Word;external;
Function FreeXms(Handle:Word):Boolean;external;
Function MoveXms(TPtr:Pointer;THandle:Word;SPtr:Pointer;SHandle:Word;Length:Longint):Word;external;

Function ReadFileToXms(Name:PathStr;Pos,Length:Longint;Mode:Byte):Word;
var
  Fp:File;
  Len,Dlt:Longint;
  Handle,Result:Word;
  i:Integer;
  P:Pointer;
begin
  ReadFileToXms:=0;
  if not XmsCanUse then Exit;
  Assign(Fp,Name);
  {$i-}Reset(Fp,1);{$i+}
  if IOResult<>0 then Exit;
  Len:=Length;
  if Mode=rxEnd then Len:=FileSize(Fp)-Pos;
  Seek(Fp,Pos);
  Handle:=MallocXms((Len-1) div 1024 +1);
  if Mode=rxUserEnd then Len:=FileSize(Fp)-Pos;
  GetMem(P,20480);
  Dlt:=0;
  for i:=0 to ((Len-1) div 20480) do
  begin
    BlockRead(Fp,P^,20480,Result);
    if Result>0 then
    begin
      if Odd(Result) then Inc(Result);
      MoveXms(Pointer(Dlt),Handle,P,0,Result);
    end;
    Inc(Dlt,Result);
  end;
  FreeMem(P,20480);
  {$i-}Close(Fp);{$i+}
  ReadFileToXms:=Handle;
end;

Procedure WriteXmsToFile(Handle:Word;Name:PathStr;Pos,Length:Longint;Mode:Byte);
var
  Fp:File;
  Len,Dlt,WriteLen:Longint;
  Result:Word;
  i:Integer;
  P:Pointer;
begin
  if (not XmsCanUse)or(Handle=0) then Exit;
  Assign(Fp,Name);
  if Mode=wxAppend then
  begin
    {$i-}Reset(Fp,1);{$i+}
    Seek(Fp,FileSize(Fp));
  end else
    {$i-}ReWrite(Fp,1);{$i+}
  if IOResult<>0 then Exit;
  Len:=Length;
  GetMem(P,20480);
  Dlt:=0;
  for i:=0 to ((Len-1) div 20480) do
  begin
    BlockRead(Fp,P^,20480,Result);
    if Dlt+20480<Len then
    begin
      MoveXms(P,0,Pointer(Pos+Dlt),Handle,20480);
      BlockWrite(Fp,P^,20480,Result);
    end else
    begin
      WriteLen:=Len-Dlt;
      if Odd(Len-Dlt) then Inc(Len);
      MoveXms(P,0,Pointer(Pos+Dlt),Handle,Len-Dlt);
      BlockWrite(Fp,P^,WriteLen,Result);
    end;
    Inc(Dlt,20480);
  end;
  FreeMem(P,20480);
  {$i-}Close(Fp);{$i+}
end;

end.