Copy and integrate content of WinClip to unit fvclip.

packages/fv/src/fvclip.inc

@@ -1,9 +1,13 @@
 {
    This unit is part of the Free Vision package
+   Copyright (c) 1999 by Pierre Muller
 
-   Copyright 2024 by Margers
+   General OS clipboard support unit.
 
-   Bracketed paste and OSC 52 clipboard support (Unix only).
+   Connection with Windows Clipboard based on Ralph Brown Interrupt List
+
+   Copyright (c) 2024 by Margers
+   Bracketed paste and OSC 52 clipboard support.
 
    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.
@@ -33,106 +37,91 @@ unit fvclip;
 interface
 
 {$undef WinClipSupported}
-
-{$ifdef LINUX}
-  {$define WinClipSupported}
-{$endif}
-{$ifdef BSD}
-  {$define WinClipSupported}
-{$endif}
-
+{$undef DOS}
+{ ----------- define DOS for DOS targets ---------- }
+{$ifdef GO32V2}{$define DOS}{$endif}
 
 function WinClipboardSupported : boolean;
 function OpenWinClipboard : boolean;
 function EmptyWinClipboard : boolean;
 function CloseWinClipboard : boolean;
 function GetTextWinClipboardSize : longint;
-function GetTextWinClipBoardData(var p : PAnsiChar;var l : longint) : boolean;
-function SetTextWinClipBoardData(p : PAnsiChar;l : longint) : boolean;
+function GetTextWinClipboardData(var p : PAnsiChar;var l : longint) : boolean;
+function SetTextWinClipboardData(p : PAnsiChar;l : longint) : boolean;
 
 {Should be called after InitKeyboard }
 procedure InitClip;
 procedure DoneClip;
 
-{Request clipboard content}
-{Actual clipboard content will be returned via event system, if terminal supports OSC 52}
-procedure GetGlobalClipboardData;
-
-{ Set clipboard content, if terminal supports OSC 52. Return true always }
-function SetGlobalClipboardData(P: PAnsiChar; ASize: longint): boolean;
-
 implementation
 
 {$IFDEF FPC_DOTTEDUNITS}
-uses
-{$ifdef unix}
-  UnixApi.Base,UnixApi.TermIO,System.Console.Keyboard, FreeVision.Sysmsg
-{$endif}
-  ,FreeVision.Fvconsts;
-{$ELSE}
-uses
+{$ifdef DOS}
+  uses
+    FreeVision.Pmode,
+{$ifdef go32v2}
+    {go32   sorry Gabor, but its still not compiling without that ! }
+    {now it works. btw. you don't have to sorry - just to tell me... ;)) Gabor }
+{$endif go32v2}
+    TP.DOS;
+{$endif DOS}
+
 {$ifdef unix}
-  baseUnix,termio,keyboard,sysmsg
+  uses
+    UnixApi.Base,UnixApi.TermIO,System.Console.Keyboard,FreeVision.Sysmsg;
 {$endif}
-  ,fvconsts;
-{$ENDIF}
 
+{$ifdef Windows}
+  uses
+    System.Strings,WinApi.Windows;
+{$endif Windows}
 
-{$ifdef UNIX}
-function WinClipboardSupported : boolean;
-var term, typ : string;
-    thistty : shortstring;
-begin
-  WinClipboardSupported:=false;
-{$ifndef LINUX}
-  thistty:=ttyname(stdinputhandle);
-  if (copy(thistty,1,8)<>'/dev/tty') then
-    WinClipboardSupported:=true; { probably we are good }
+{$ifdef HASAMIGA}
+  uses
+    {$ifdef AMIGA68K} Amiga.Core.Clipboard,{$endif}
+    {$ifdef AMIGAOS4} AmigaApi.Clipboard,{$endif}
+    {$ifdef AROS} AROSApi.Clipboard,{$endif}
+    {$ifdef MorphOS} MorphApi.Clipboard,{$endif}
+    AmigaApi.Cliputils;
 {$endif}
-{$ifdef LINUX}
-  typ:=fpgetenv('XDG_SESSION_TYPE');
-  if length(typ)>0 then
-    if lowercase(typ)='tty' then
-      Exit; { in console mode OSC 52 is not supported }
-  term:=fpgetenv('TERM');
-  if length(term)>0 then
-    if lowercase(term)<>'linux' then
-      WinClipboardSupported:=true; { probably we are good }
-{$endif}
-end;
 
-function OpenWinClipboard : boolean;
-begin
-  OpenWinClipboard:=true;
-end;
+{$ifdef os2}
+  uses
+    OS2Api.DosCalls, OS2Api.OS2Def;
+{$endif os2}
 
-function EmptyWinClipboard : boolean;
-begin
-  EmptyWinClipboard:=true;
-end;
+{$ELSE  not FPC_DOTTEDUNITS}
+{$ifdef DOS}
+  uses
+    pmode,
+{$ifdef go32v2}
+    {go32   sorry Gabor, but its still not compiling without that ! }
+    {now it works. btw. you don't have to sorry - just to tell me... ;)) Gabor }
+{$endif go32v2}
+    dos;
+{$endif DOS}
 
-function CloseWinClipboard : boolean;
-begin
-  CloseWinClipboard:=true;
-end;
+{$ifdef unix}
+  uses
+    baseUnix,termio,keyboard,sysmsg;
+{$endif}
 
-function GetTextWinClipboardSize : longint;
-begin
-  GetTextWinClipboardSize:=0;
-end;
+{$ifdef Windows}
+  uses
+    strings,windows;
+{$endif Windows}
 
-function GetTextWinClipBoardData(var P : PAnsiChar;var L : longint) : boolean;
-begin
-  GetTextWinClipBoardData:=true;
-  GetGlobalClipboardData;
-end;
-
-function SetTextWinClipBoardData(P : PAnsiChar; L : longint) : boolean;
-begin
-  SetTextWinClipBoardData:= SetGlobalClipboardData(P,L);
-end;
+{$ifdef HASAMIGA}
+  uses
+    clipboard,cliputils;
 {$endif}
 
+{$ifdef os2}
+  uses
+    DosCalls, OS2Def;
+{$endif os2}
+
+{$ENDIF  FPC_DOTTEDUNITS}
 
 
 {$ifdef UNIX}
@@ -423,7 +412,571 @@ begin
 end;
 
 
-{$ifndef WinClipSupported}
+{$ifdef DOS}
+{$define WinClipSupported}
+function WinClipboardSupported : boolean;
+var
+  r : registers;
+begin
+  r.ax:=$1700;
+  RealIntr($2F,r);
+  WinClipboardSupported:=(r.ax<>$1700);
+end;
+
+function OpenWinClipboard : boolean;
+var
+  r : Registers;
+begin
+  r.ax:=$1701;
+  RealIntr($2F,r);
+  OpenWinClipboard:=(r.ax<>0);
+end;
+
+function EmptyWinClipboard : boolean;
+var
+  r : Registers;
+begin
+  r.ax:=$1702;
+  RealIntr($2F,r);
+  EmptyWinClipboard:=(r.ax<>0);
+end;
+
+function CloseWinClipboard : boolean;
+var
+  r : Registers;
+begin
+  r.ax:=$1708;
+  RealIntr($2F,r);
+  CloseWinClipboard:=(r.ax<>0);
+end;
+
+function InternGetDataSize : longint;
+var
+  r : Registers;
+begin
+  r.ax:=$1704;
+  r.dx:=7 {OEM Text rather then 1 : Text };
+  RealIntr($2F,r);
+  InternGetDataSize:=(r.dx shl 16) + r.ax;
+end;
+{$endif DOS}
+
+{$ifdef UNIX}
+{$define WinClipSupported}
+function WinClipboardSupported : boolean;
+var term, typ : string;
+    thistty : shortstring;
+begin
+  WinClipboardSupported:=false;
+{$if not defined(LINUX) and not defined(BSD)}
+  Exit; { Report as not supported when in realty it has not been tested. }
+{$endif}
+{$ifndef LINUX}
+  thistty:=ttyname(stdinputhandle);
+  if (copy(thistty,1,8)<>'/dev/tty') then
+    WinClipboardSupported:=true; { probably we are good }
+{$endif}
+{$ifdef LINUX}
+  typ:=fpgetenv('XDG_SESSION_TYPE');
+  if length(typ)>0 then
+    if lowercase(typ)='tty' then
+      Exit; { in console mode OSC 52 is not supported }
+  term:=fpgetenv('TERM');
+  if length(term)>0 then
+    if lowercase(term)<>'linux' then
+      WinClipboardSupported:=true; { probably we are good }
+{$endif}
+end;
+
+function OpenWinClipboard : boolean;
+begin
+  OpenWinClipboard:=true;
+end;
+
+function EmptyWinClipboard : boolean;
+begin
+  EmptyWinClipboard:=true;
+end;
+
+function CloseWinClipboard : boolean;
+begin
+  CloseWinClipboard:=true;
+end;
+
+function GetTextWinClipboardSize : longint;
+begin
+  GetTextWinClipboardSize:=1;  {there has to be something in order for menu to be active}
+end;
+
+function GetTextWinClipBoardData(var P : PAnsiChar;var L : longint) : boolean;
+begin
+  GetTextWinClipBoardData:=true;
+  P:=nil;L:=0;              { Have no immediate response }
+  GetGlobalClipboardData;   { Request now, get clipboard data later }
+end;
+
+function SetTextWinClipBoardData(P : PAnsiChar; L : longint) : boolean;
+begin
+  SetTextWinClipBoardData:= SetGlobalClipboardData(P,L);
+end;
+{$endif}
+
+{$ifdef Windows}
+{$define WinClipSupported}
+function WinClipboardSupported : boolean;
+begin
+  WinClipboardSupported:=true;
+end;
+
+function OpenWinClipboard : boolean;
+begin
+  OpenWinClipboard:=OpenClipboard(0);
+end;
+
+function EmptyWinClipboard : boolean;
+begin
+  EmptyWinClipboard:=EmptyClipboard;
+end;
+
+function CloseWinClipboard : boolean;
+begin
+  CloseWinClipboard:=CloseClipboard;
+end;
+
+function InternGetDataSize : longint;
+var HC : Handle;
+begin
+  HC:=GetClipBoardData(CF_OEMTEXT);
+  if HC<>0 then
+    begin
+      InternGetDataSize:=strlen(PAnsiChar(GlobalLock(HC)))+1;
+      GlobalUnlock(HC);
+    end
+  else
+    InternGetDataSize:=0;
+end;
+{$endif Windows}
+
+{$ifdef HASAMIGA}
+{$define WinClipSupported}
+function WinClipboardSupported: Boolean;
+begin
+  WinClipboardSupported := True;
+end;
+
+function OpenWinClipboard: boolean;
+begin
+  OpenWinClipboard := True;
+end;
+
+function EmptyWinClipboard: boolean;
+begin
+  EmptyWinClipboard := GetTextFromClip(PRIMARY_CLIP) = '';
+end;
+
+function CloseWinClipboard : boolean;
+begin
+  CloseWinClipboard:= True;
+end;
+
+function InternGetDataSize: LongInt;
+var
+  Text: string;
+begin
+  Text := GetTextFromClip(PRIMARY_CLIP);
+  InternGetDataSize := Length(Text);
+end;
+{$endif HASAMIGA}
+
+{$ifdef os2}
+{$define WinClipSupported}
+const
+  CF_TEXT = 1;
+  CF_BITMAP = 2;
+  CF_DSPTEXT = 3;
+  CF_DSPBITMAP = 4;
+  CF_METAFILE = 5;
+  CF_DSPMETAFILE = 6;
+  CF_PALETTE = 9;
+
+  CFI_OWNERFREE = $0001;
+  CFI_OWNERDISPLAY = $0002;
+  CFI_POINTER = $0400;
+  CFI_HANDLE = $0200;
+
+var
+  OS2ClipboardSupported: boolean = false;
+  PMWHandle: cardinal;
+  MsgQueueHandle: cardinal;
+  PIB: PProcessInfoBlock;
+
+type
+(*  TWinSetClipbrdOwner = function (hab, hwnd: cardinal): longbool; cdecl;*)
+  TWinSetClipbrdData = function (hab, ulData, fmt, rgfFmtInfo: cardinal): longbool;  cdecl;
+  TWinQueryClipbrdData = function (hab, fmt: cardinal): cardinal; cdecl;
+  TWinQueryClipbrdFmtInfo = function (hab, fmt: cardinal; var prgfFmtInfo: cardinal): longbool; cdecl;
+{    function WinSetClipbrdViewer(hab,hwndNewClipViewer : cardinal) : longbool;  cdecl;}
+{    function WinEnumClipbrdFmts(hab,fmt : cardinal) : cardinal; cdecl;}
+  TWinEmptyClipbrd = function (hab: cardinal): longbool; cdecl;
+  TWinOpenClipbrd = function (hab: cardinal): longbool; cdecl;
+  TWinCloseClipbrd = function (hab: cardinal): longbool; cdecl;
+(*  TWinQueryClipbrdOwner = function (hab: cardinal): cardinal; cdecl;*)
+{    function WinQueryClipbrdViewer(hab : cardinal) : cardinal; cdecl;}
+  TWinInitialize = function (flOptions: cardinal): cardinal; cdecl;
+  TWinTerminate = function (hab: cardinal): longbool; cdecl;
+  TWinCreateMsgQueue = function (hab: cardinal; cmsg: longint): cardinal; cdecl;
+  TWinDestroyMsgQueue = function (hmq: cardinal): longbool; cdecl;
+
+var
+(*  WinSetClipbrdOwner: TWinSetClipbrdOwner;*)
+  ClWinSetClipbrdData: TWinSetClipbrdData;
+  ClWinQueryClipbrdData: TWinQueryClipbrdData;
+  ClWinQueryClipbrdFmtInfo: TWinQueryClipbrdFmtInfo;
+{    function WinSetClipbrdViewer(hab,hwndNewClipViewer : cardinal) : longbool;  cdecl;}
+{    function WinEnumClipbrdFmts(hab,fmt : cardinal) : cardinal; cdecl;}
+  ClWinEmptyClipbrd: TWinEmptyClipbrd;
+  ClWinOpenClipbrd: TWinOpenClipbrd;
+  ClWinCloseClipbrd: TWinCloseClipbrd;
+(*  WinQueryClipbrdOwner: TWinQueryClipbrdOwner;*)
+{    function WinQueryClipbrdViewer(hab : cardinal) : cardinal; cdecl;}
+  ClWinInitialize: TWinInitialize;
+  ClWinTerminate: TWinTerminate;
+  ClWinCreateMsgQueue: TWinCreateMsgQueue;
+  ClWinDestroyMsgQueue: TWinDestroyMsgQueue;
+
+  OrigSessType: cardinal;
+
+
+function WinClipboardSupported : boolean;
+begin
+  WinClipboardSupported:=OS2ClipboardSupported;
+end;
+
+function OpenWinClipboard : boolean;
+var
+  SessType: cardinal;
+begin
+  OpenWinClipboard := false;
+  if not (OS2ClipboardSupported) then
+   Exit;
+  SessType := PIB^.tType;
+  PIB^.tType := 3;
+  OpenWinClipboard := ClWinOpenClipbrd (PMWHandle);
+  PIB^.tType := SessType;
+end;
+
+function EmptyWinClipboard : boolean;
+var
+  SessType: cardinal;
+begin
+  EmptyWinClipboard := false;
+  if not (OS2ClipboardSupported) then
+   Exit;
+  SessType := PIB^.tType;
+  PIB^.tType := 3;
+  EmptyWinClipboard := ClWinEmptyClipbrd (PMWHandle);
+  PIB^.tType := SessType;
+end;
+
+function CloseWinClipboard : boolean;
+var
+  SessType: cardinal;
+begin
+  CloseWinClipboard := false;
+  if not (OS2ClipboardSupported) then
+   Exit;
+  SessType := PIB^.tType;
+  PIB^.tType := 3;
+  CloseWinClipboard := ClWinCloseClipbrd (PMWHandle);
+  PIB^.tType := SessType;
+end;
+
+function InternGetDataSize : longint;
+var
+  P: PAnsiChar;
+  SessType: cardinal;
+begin
+  InternGetDataSize := 0;
+  if not (OS2ClipboardSupported) then
+   Exit;
+  SessType := PIB^.tType;
+  PIB^.tType := 3;
+  P := PAnsiChar (ClWinQueryClipbrdData (PMWHandle, CF_TEXT));
+  PIB^.tType := SessType;
+
+  if P <> nil then
+   InternGetDataSize := StrLen (PAnsiChar (P)) + 1;
+end;
+
+procedure InitClipboard;
+var
+  RC: cardinal;
+  ProcOK: boolean;
+  TIB: PThreadInfoBlock;
+  PMWModHandle: THandle;
+  Err: string;
+  ErrL: cardinal;
+begin
+  if OS2ClipboardSupported then
+   Exit;
+  DosGetInfoBlocks (TIB, PIB);
+  OrigSessType := PIB^.tType;
+  PIB^.tType := 3;
+
+{  RC := DosQueryModuleHandle ('PMWIN', PMWModHandle);}
+  RC := DosLoadModule (Err, ErrL, 'PMWIN', PMWModHandle);
+  if RC <> 0 then
+   begin
+    PIB^.tType := OrigSessType;
+    Exit;
+   end;
+
+  ProcOK := (DosQueryProcAddr (PMWModHandle, 707, nil, pointer (ClWinCloseClipbrd)) = 0)
+     and
+   (DosQueryProcAddr (PMWModHandle, 716, nil, pointer (ClWinCreateMsgQueue)) = 0) and
+   (DosQueryProcAddr (PMWModHandle, 726, nil, pointer (ClWinDestroyMsgQueue)) = 0) and
+   (DosQueryProcAddr (PMWModHandle, 733, nil, pointer (ClWinEmptyClipbrd)) = 0) and
+   (DosQueryProcAddr (PMWModHandle, 763, nil, pointer (ClWinInitialize)) = 0) and
+   (DosQueryProcAddr (PMWModHandle, 793, nil, pointer (ClWinOpenClipbrd)) = 0) and
+   (DosQueryProcAddr (PMWModHandle, 806, nil, pointer (ClWinQueryClipbrdData)) = 0) and
+   (DosQueryProcAddr (PMWModHandle, 807, nil, pointer (ClWinQueryClipbrdFmtInfo)) = 0) and
+   (DosQueryProcAddr (PMWModHandle, 854, nil, pointer (ClWinSetClipbrdData)) = 0) and
+   (DosQueryProcAddr (PMWModHandle, 888, nil, pointer (ClWinTerminate)) = 0);
+
+  if ProcOK then
+   begin
+    PMWHandle := ClWinInitialize (0);
+    if PMWHandle <> 0 then
+     begin
+      MsgQueueHandle := ClWinCreateMsgQueue (PMWHandle, 0);
+      ProcOK := MsgQueueHandle <> 0;
+     end
+    else
+     ProcOK := false;
+   end;
+
+  PIB^.tType := OrigSessType;
+
+  if ProcOK then
+   OS2ClipboardSupported := true;
+end;
+
+procedure DoneClipboard;
+var
+  SessType: cardinal;
+begin
+  if not (OS2ClipboardSupported) then
+   Exit;
+  OS2ClipboardSupported := false;
+  SessType := PIB^.tType;
+  PIB^.tType := 3;
+  if MsgQueueHandle <> 0 then
+   begin
+    ClWinDestroyMsgQueue (MsgQueueHandle);
+    MsgQueueHandle := 0;
+   end;
+  if PMWHandle <> 0 then
+   begin
+    ClWinTerminate (PMWHandle);
+    PMWHandle := 0;
+   end;
+  PIB^.tType := SessType;
+end;
+{$endif os2}
+
+{$ifndef UNIX} { Unix have defined all functions, lets go for every other system }
+{$ifdef WinClipSupported}
+function GetTextWinClipboardSize : longint;
+begin
+  OpenWinClipboard;
+  GetTextWinClipboardSize:=InternGetDataSize;
+  CloseWinClipboard;
+end;
+
+function GetTextWinClipBoardData(var p : PAnsiChar;var l : longint) : boolean;
+var
+{$ifdef DOS}
+  r : Registers;
+  M : MemPtr;
+  pp: PAnsiChar;
+{$endif DOS}
+{$ifdef Windows}
+  h : HGlobal;
+  pp : PAnsiChar;
+{$endif Windows}
+{$ifdef HASAMIGA}
+  Text: AnsiString;
+  pp: PAnsiChar;
+{$endif HASAMIGA}
+{$IFDEF OS2}
+  PP: PAnsiChar;
+  SessType: cardinal;
+{$ENDIF OS2}
+begin
+  p:=nil;
+  GetTextWinClipBoardData:=False;
+  if not OpenWinClipBoard then
+    exit;
+{$ifdef DOS}
+  l:=InternGetDataSize;
+  if (l=0) or (l>65520) then
+    begin
+      l:=0;
+      CloseWinClipBoard;
+      exit;
+    end;
+  GetMem(p,l+1);
+  GetDosMem(M,l);
+  r.ax:=$1705;
+  r.dx:=7{ OEM Text rather then 1 : Text };
+  r.es:=M.DosSeg;
+  r.bx:=M.DosOfs;
+  RealIntr($2F,r);
+  GetTextWinClipBoardData:=(r.ax<>0);
+{$endif DOS}
+{$ifdef Windows}
+  h:=GetClipboardData(CF_OEMTEXT);
+  if h<>0 then
+    begin
+      pp:=PAnsiChar(GlobalLock(h));
+      l:=strlen(pp)+1;
+      getmem(p,l);
+      move(pp^,p^,l);
+      GlobalUnlock(h);
+    end;
+  GetTextWinClipBoardData:=h<>0;
+{$endif Windows}
+{$ifdef HASAMIGA}
+  Text := GetTextFromClip(0) + #0;
+  PP := @Text[1];
+  l := Length(Text);
+  GetMem(p,l);
+  Move(pp^,p^,l);
+  GetTextWinClipBoardData := True;
+{$endif HASAMIGA}
+{$IFDEF OS2}
+  GetTextWinClipboardData := false;
+  L := 0;
+  if not (OS2ClipboardSupported) then
+   Exit;
+  SessType := PIB^.tType;
+  PIB^.tType := 3;
+  PP := PAnsiChar (ClWinQueryClipbrdData (PMWHandle, CF_TEXT));
+  PIB^.tType := SessType;
+
+  if PP <> nil then
+   begin
+    L := StrLen (PAnsiChar (PP)) + 1;
+    GetMem (P, L);
+    if P <> nil then
+     begin
+      Move (PP^, P^, L);
+      GetTextWinClipBoardData := true;
+     end;
+   end;
+{$ENDIF OS2}
+  CloseWinClipBoard;
+{$ifdef DOS}
+  M.MoveDataFrom(l,P^);
+  FreeDosMem(M);
+  pp:=p+l;
+  pp^:=#0; { make null terminated }
+{$endif DOS}
+end;
+
+function SetTextWinClipBoardData(p : PAnsiChar;l : longint) : boolean;
+var
+{$ifdef DOS}
+  r : Registers;
+  M : MemPtr;
+  pp: PAnsiChar;
+  op: PAnsiChar;
+{$endif DOS}
+{$ifdef Windows}
+  h : HGlobal;
+  pp : PAnsiChar;
+  res : boolean;
+{$endif Windows}
+{$ifdef HASAMIGA}
+  pp: PAnsiChar;
+  Test: AnsiString;
+{$endif HASAMIGA}
+{$IFDEF OS2}
+  RC: cardinal;
+  PShared: pointer;
+  SessType: cardinal;
+{$ENDIF OS2}
+begin
+  SetTextWinClipBoardData:=False;
+  if (l=0) or (l>65520) then
+    exit;
+  if not OpenWinClipBoard then
+    exit;
+  EmptyWinClipBoard;
+{$ifdef DOS}
+  GetMem(pp,l+1);
+  Move(p^,pp^,l);
+  op:=pp+l;
+  op^:=#0; { make sure that string is null terminated }
+  GetDosMem(M,l+1);
+  M.MoveDataTo(PP^,l+1);
+  FreeMem(pp);
+  r.ax:=$1703;
+  r.dx:=7{ OEM Text rather then 1 : Text };
+  r.es:=M.DosSeg;
+  r.bx:=M.DosOfs;
+  r.si:=l shr 16;
+  r.cx:=l and $ffff;
+  RealIntr($2F,r);
+  SetTextWinClipBoardData:=(r.ax<>0);
+  (*
+  r.ax:=$1703;
+  r.dx:=1{ Empty  Text };
+  r.es:=M.DosSeg;
+  r.bx:=M.DosOfs;
+  r.si:=0;
+  r.cx:=0;
+  RealIntr($2F,r);
+  *)
+  FreeDosMem(M);
+{$endif DOS}
+{$ifdef Windows}
+  h:=GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE,l+1);
+  pp:=PAnsiChar(GlobalLock(h));
+  move(p^,pp^,l+1);
+  GlobalUnlock(h);
+  res:=(SetClipboardData(CF_OEMTEXT,h)=h);
+  h:=GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE,l+1);
+  pp:=PAnsiChar(GlobalLock(h));
+  OemToCharBuffA(p,pp,l+1);
+  SetClipboardData(CF_TEXT,h);
+  GlobalUnlock(h);
+  SetTextWinClipBoardData:=res;
+{$endif Windows}
+{$ifdef HASAMIGA}
+  PutTextToClip(0, AnsiString(p));
+{$endif HASAMIGA}
+{$IFDEF OS2}
+  SetTextWinClipboardData := false;
+  if not (OS2ClipboardSupported) then
+   Exit;
+  RC := DosAllocSharedMem (PShared, nil, Succ (L),
+                                      PAG_WRITE or PAG_COMMIT or OBJ_GIVEABLE);
+  if RC = 0 then
+   begin
+    Move (P^, PShared^, Succ (L));
+
+    SessType := PIB^.tType;
+    PIB^.tType := 3;
+    SetTextWinClipboardData := ClWinSetClipbrdData (PMWHandle,
+                                     cardinal (PShared), CF_TEXT, CFI_POINTER);
+    PIB^.tType := SessType;
+   end;
+{$ENDIF OS2}
+  CloseWinClipBoard;
+end;
+
+{$else WinClipSupported}
 { Implementation for not supported OS clipboard. }
 
 function WinClipboardSupported : boolean;
@@ -461,6 +1014,13 @@ begin
   SetTextWinClipBoardData:=false;
 end;
 {$endif}
+{$endif UNIX}
 
+{$ifdef os2}
+initialization
+ InitClipboard;
 
+finalization
+ DoneClipboard;
+{$endif os2}
 end.