FreeXP

CVS daily diff

FreeXP CVS-Server cvs-list at freexp.de
Sam Okt 8 00:00:23 CEST 2005


Index: freexp/crc.pas
===================================================================
RCS file: /server/cvs/freexp/crc.pas,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- freexp/crc.pas	1 Jan 2005 11:16:27 -0000	1.6
+++ freexp/crc.pas	7 Oct 2005 10:46:14 -0000	1.7
@@ -8,7 +8,7 @@
 { Die Nutzungsbedingungen fuer diesen Quelltext finden Sie in der }
 { Datei SLIZENZ.TXT oder auf www.crosspoint.de/oldlicense.html.   }
 { --------------------------------------------------------------- }
-{ $Id: crc.pas,v 1.6 2005/01/01 11:16:27 mw Exp $ }
+{ $Id: crc.pas,v 1.7 2005/10/07 10:46:14 mw Exp $ }
 UNIT CRC;
 
 {$I XPDEFINE.INC }
@@ -32,6 +32,20 @@
 function CRC32Block(var data; size: word): longint;
 function CRC32Str(s: string): longint;
 
+{ Routinen fuer CRC64 }
+type
+  TCRC64 = packed record
+             lo32, hi32: longint;
+           end;
+
+procedure CRC64Init(var CRC: TCRC64);                             {-CRC64 initialization}
+
+procedure CRC64Update(var CRC: TCRC64; Msg: pointer; Len: word);  {-update CRC64 with Msg data}
+
+procedure CRC64Final(var CRC: TCRC64);                            {-CRC64: finalize calculation}
+
+procedure CRC64Full(var CRC: TCRC64; Msg: pointer; Len: word);    {-CRC64 of Msg with init/update/final}
+
 implementation
 
 var
@@ -216,10 +230,265 @@
   CRC32block := CRC_Reg;
 end;
 
+(*----------------------------- CRC64 Routinen -----------------------------*)
+(*--------------------------------------------------------------------------
+ (C) Copyright 2005      Martin Wodrich 
+
+ Modifikation um ohne Assembler-Abschnitte, lange Define-Abschnitte
+ und Includes auszukommen (Erleichtert die Itegration in bestehende
+ Pascal-Units von FreeXP und OpenXP).
+ 
+ Der Code an sich ist Copyright 2002-2004 Wolfgang Ehrhardt 
+----------------------------------------------------------------------------*)
+
+(*-------------------------------------------------------------------------
+ (C) Copyright 2002-2004 Wolfgang Ehrhardt
+
+ This software is provided 'as-is', without any express or implied warranty.
+ In no event will the authors be held liable for any damages arising from
+ the use of this software.
+
+ Permission is granted to anyone to use this software for any purpose,
+ including commercial applications, and to alter it and redistribute it
+ freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must not
+    claim that you wrote the original software. If you use this software in
+    a product, an acknowledgment in the product documentation would be
+    appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must not be
+    misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+----------------------------------------------------------------------------*)
+
+CONST  Mask64 : TCRC64  = (lo32:-1; hi32:-1);
+
+{$ifdef FPC}
+{$ifndef VER1_0}
+  {$warnings off}
+  {$R-} {avoid D9 errors!}
+{$endif}
+{$endif}
+
+(*************************************************************************
+T_CTab64 - CRC64 table calculation     (c) 2002-2004 W.Ehrhardt
+
+Calculate CRC64 tables for polynomial:
+
+x^64 + x^62 + x^57 + x^55 + x^54 + x^53 + x^52 + x^47 + x^46 + x^45 +
+x^40 + x^39 + x^38 + x^37 + x^35 + x^33 + x^32 + x^31 + x^29 + x^27 +
+x^24 + x^23 + x^22 + x^21 + x^19 + x^17 + x^13 + x^12 + x^10 + x^9  +
+x^7  + x^4  + x^1  + 1
+
+const
+  PolyLo = $A9EA3693;
+  PolyHi = $42F0E1EB;
+*************************************************************************)
+
+
+const Tab64lo : array[0..255] of longint = (
+    $00000000,    $A9EA3693,    $53D46D26,    $FA3E5BB5,
+    $0E42ECDF,    $A7A8DA4C,    $5D9681F9,    $F47CB76A,
+    $1C85D9BE,    $B56FEF2D,    $4F51B498,    $E6BB820B,
+    $12C73561,    $BB2D03F2,    $41135847,    $E8F96ED4,
+    $90E185EF,    $390BB37C,    $C335E8C9,    $6ADFDE5A,
+    $9EA36930,    $37495FA3,    $CD770416,    $649D3285,
+    $8C645C51,    $258E6AC2,    $DFB03177,    $765A07E4,
+    $8226B08E,    $2BCC861D,    $D1F2DDA8,    $7818EB3B,
+    $21C30BDE,    $88293D4D,    $721766F8,    $DBFD506B,
+    $2F81E701,    $866BD192,    $7C558A27,    $D5BFBCB4,
+    $3D46D260,    $94ACE4F3,    $6E92BF46,    $C77889D5,
+    $33043EBF,    $9AEE082C,    $60D05399,    $C93A650A,
+    $B1228E31,    $18C8B8A2,    $E2F6E317,    $4B1CD584,
+    $BF6062EE,    $168A547D,    $ECB40FC8,    $455E395B,
+    $ADA7578F,    $044D611C,    $FE733AA9,    $57990C3A,
+    $A3E5BB50,    $0A0F8DC3,    $F031D676,    $59DBE0E5,
+    $EA6C212F,    $438617BC,    $B9B84C09,    $10527A9A,
+    $E42ECDF0,    $4DC4FB63,    $B7FAA0D6,    $1E109645,
+    $F6E9F891,    $5F03CE02,    $A53D95B7,    $0CD7A324,
+    $F8AB144E,    $514122DD,    $AB7F7968,    $02954FFB,
+    $7A8DA4C0,    $D3679253,    $2959C9E6,    $80B3FF75,
+    $74CF481F,    $DD257E8C,    $271B2539,    $8EF113AA,
+    $66087D7E,    $CFE24BED,    $35DC1058,    $9C3626CB,
+    $684A91A1,    $C1A0A732,    $3B9EFC87,    $9274CA14,
+    $CBAF2AF1,    $62451C62,    $987B47D7,    $31917144,
+    $C5EDC62E,    $6C07F0BD,    $9639AB08,    $3FD39D9B,
+    $D72AF34F,    $7EC0C5DC,    $84FE9E69,    $2D14A8FA,
+    $D9681F90,    $70822903,    $8ABC72B6,    $23564425,
+    $5B4EAF1E,    $F2A4998D,    $089AC238,    $A170F4AB,
+    $550C43C1,    $FCE67552,    $06D82EE7,    $AF321874,
+    $47CB76A0,    $EE214033,    $141F1B86,    $BDF52D15,
+    $49899A7F,    $E063ACEC,    $1A5DF759,    $B3B7C1CA,
+    $7D3274CD,    $D4D8425E,    $2EE619EB,    $870C2F78,
+    $73709812,    $DA9AAE81,    $20A4F534,    $894EC3A7,
+    $61B7AD73,    $C85D9BE0,    $3263C055,    $9B89F6C6,
+    $6FF541AC,    $C61F773F,    $3C212C8A,    $95CB1A19,
+    $EDD3F122,    $4439C7B1,    $BE079C04,    $17EDAA97,
+    $E3911DFD,    $4A7B2B6E,    $B04570DB,    $19AF4648,
+    $F156289C,    $58BC1E0F,    $A28245BA,    $0B687329,
+    $FF14C443,    $56FEF2D0,    $ACC0A965,    $052A9FF6,
+    $5CF17F13,    $F51B4980,    $0F251235,    $A6CF24A6,
+    $52B393CC,    $FB59A55F,    $0167FEEA,    $A88DC879,
+    $4074A6AD,    $E99E903E,    $13A0CB8B,    $BA4AFD18,
+    $4E364A72,    $E7DC7CE1,    $1DE22754,    $B40811C7,
+    $CC10FAFC,    $65FACC6F,    $9FC497DA,    $362EA149,
+    $C2521623,    $6BB820B0,    $91867B05,    $386C4D96,
+    $D0952342,    $797F15D1,    $83414E64,    $2AAB78F7,
+    $DED7CF9D,    $773DF90E,    $8D03A2BB,    $24E99428,
+    $975E55E2,    $3EB46371,    $C48A38C4,    $6D600E57,
+    $991CB93D,    $30F68FAE,    $CAC8D41B,    $6322E288,
+    $8BDB8C5C,    $2231BACF,    $D80FE17A,    $71E5D7E9,
+    $85996083,    $2C735610,    $D64D0DA5,    $7FA73B36,
+    $07BFD00D,    $AE55E69E,    $546BBD2B,    $FD818BB8,
+    $09FD3CD2,    $A0170A41,    $5A2951F4,    $F3C36767,
+    $1B3A09B3,    $B2D03F20,    $48EE6495,    $E1045206,
+    $1578E56C,    $BC92D3FF,    $46AC884A,    $EF46BED9,
+    $B69D5E3C,    $1F7768AF,    $E549331A,    $4CA30589,
+    $B8DFB2E3,    $11358470,    $EB0BDFC5,    $42E1E956,
+    $AA188782,    $03F2B111,    $F9CCEAA4,    $5026DC37,
+    $A45A6B5D,    $0DB05DCE,    $F78E067B,    $5E6430E8,
+    $267CDBD3,    $8F96ED40,    $75A8B6F5,    $DC428066,
+    $283E370C,    $81D4019F,    $7BEA5A2A,    $D2006CB9,
+    $3AF9026D,    $931334FE,    $692D6F4B,    $C0C759D8,
+    $34BBEEB2,    $9D51D821,    $676F8394,    $CE85B507);
+
+const Tab64hi : array[0..255] of longint = (
+    $00000000,    $42F0E1EB,    $85E1C3D7,    $C711223C,
+    $49336645,    $0BC387AE,    $CCD2A592,    $8E224479,
+    $9266CC8A,    $D0962D61,    $17870F5D,    $5577EEB6,
+    $DB55AACF,    $99A54B24,    $5EB46918,    $1C4488F3,
+    $663D78FF,    $24CD9914,    $E3DCBB28,    $A12C5AC3,
+    $2F0E1EBA,    $6DFEFF51,    $AAEFDD6D,    $E81F3C86,
+    $F45BB475,    $B6AB559E,    $71BA77A2,    $334A9649,
+    $BD68D230,    $FF9833DB,    $388911E7,    $7A79F00C,
+    $CC7AF1FF,    $8E8A1014,    $499B3228,    $0B6BD3C3,
+    $854997BA,    $C7B97651,    $00A8546D,    $4258B586,
+    $5E1C3D75,    $1CECDC9E,    $DBFDFEA2,    $990D1F49,
+    $172F5B30,    $55DFBADB,    $92CE98E7,    $D03E790C,
+    $AA478900,    $E8B768EB,    $2FA64AD7,    $6D56AB3C,
+    $E374EF45,    $A1840EAE,    $66952C92,    $2465CD79,
+    $3821458A,    $7AD1A461,    $BDC0865D,    $FF3067B6,
+    $711223CF,    $33E2C224,    $F4F3E018,    $B60301F3,
+    $DA050215,    $98F5E3FE,    $5FE4C1C2,    $1D142029,
+    $93366450,    $D1C685BB,    $16D7A787,    $5427466C,
+    $4863CE9F,    $0A932F74,    $CD820D48,    $8F72ECA3,
+    $0150A8DA,    $43A04931,    $84B16B0D,    $C6418AE6,
+    $BC387AEA,    $FEC89B01,    $39D9B93D,    $7B2958D6,
+    $F50B1CAF,    $B7FBFD44,    $70EADF78,    $321A3E93,
+    $2E5EB660,    $6CAE578B,    $ABBF75B7,    $E94F945C,
+    $676DD025,    $259D31CE,    $E28C13F2,    $A07CF219,
+    $167FF3EA,    $548F1201,    $939E303D,    $D16ED1D6,
+    $5F4C95AF,    $1DBC7444,    $DAAD5678,    $985DB793,
+    $84193F60,    $C6E9DE8B,    $01F8FCB7,    $43081D5C,
+    $CD2A5925,    $8FDAB8CE,    $48CB9AF2,    $0A3B7B19,
+    $70428B15,    $32B26AFE,    $F5A348C2,    $B753A929,
+    $3971ED50,    $7B810CBB,    $BC902E87,    $FE60CF6C,
+    $E224479F,    $A0D4A674,    $67C58448,    $253565A3,
+    $AB1721DA,    $E9E7C031,    $2EF6E20D,    $6C0603E6,
+    $F6FAE5C0,    $B40A042B,    $731B2617,    $31EBC7FC,
+    $BFC98385,    $FD39626E,    $3A284052,    $78D8A1B9,
+    $649C294A,    $266CC8A1,    $E17DEA9D,    $A38D0B76,
+    $2DAF4F0F,    $6F5FAEE4,    $A84E8CD8,    $EABE6D33,
+    $90C79D3F,    $D2377CD4,    $15265EE8,    $57D6BF03,
+    $D9F4FB7A,    $9B041A91,    $5C1538AD,    $1EE5D946,
+    $02A151B5,    $4051B05E,    $87409262,    $C5B07389,
+    $4B9237F0,    $0962D61B,    $CE73F427,    $8C8315CC,
+    $3A80143F,    $7870F5D4,    $BF61D7E8,    $FD913603,
+    $73B3727A,    $31439391,    $F652B1AD,    $B4A25046,
+    $A8E6D8B5,    $EA16395E,    $2D071B62,    $6FF7FA89,
+    $E1D5BEF0,    $A3255F1B,    $64347D27,    $26C49CCC,
+    $5CBD6CC0,    $1E4D8D2B,    $D95CAF17,    $9BAC4EFC,
+    $158E0A85,    $577EEB6E,    $906FC952,    $D29F28B9,
+    $CEDBA04A,    $8C2B41A1,    $4B3A639D,    $09CA8276,
+    $87E8C60F,    $C51827E4,    $020905D8,    $40F9E433,
+    $2CFFE7D5,    $6E0F063E,    $A91E2402,    $EBEEC5E9,
+    $65CC8190,    $273C607B,    $E02D4247,    $A2DDA3AC,
+    $BE992B5F,    $FC69CAB4,    $3B78E888,    $79880963,
+    $F7AA4D1A,    $B55AACF1,    $724B8ECD,    $30BB6F26,
+    $4AC29F2A,    $08327EC1,    $CF235CFD,    $8DD3BD16,
+    $03F1F96F,    $41011884,    $86103AB8,    $C4E0DB53,
+    $D8A453A0,    $9A54B24B,    $5D459077,    $1FB5719C,
+    $919735E5,    $D367D40E,    $1476F632,    $568617D9,
+    $E085162A,    $A275F7C1,    $6564D5FD,    $27943416,
+    $A9B6706F,    $EB469184,    $2C57B3B8,    $6EA75253,
+    $72E3DAA0,    $30133B4B,    $F7021977,    $B5F2F89C,
+    $3BD0BCE5,    $79205D0E,    $BE317F32,    $FCC19ED9,
+    $86B86ED5,    $C4488F3E,    $0359AD02,    $41A94CE9,
+    $CF8B0890,    $8D7BE97B,    $4A6ACB47,    $089A2AAC,
+    $14DEA25F,    $562E43B4,    $913F6188,    $D3CF8063,
+    $5DEDC41A,    $1F1D25F1,    $D80C07CD,    $9AFCE626);
+
+{$ifdef FPC}
+{$ifndef VER1_0}
+  {$warnings on}
+  {$ifdef RangeChecks_on}
+    {$R+}
+  {$endif}
+{$endif}
+{$endif}
+
+{---------------------------------------------------------------------------}
+procedure CRC64Update(var CRC: TCRC64; Msg: pointer; Len: word);
+  {-update CRC64 with Msg data}
+type
+  PByte = ^byte;
+var
+  i,it: word;
+  clo,chi: longint;
+type
+  BR = packed record
+         b0,b1,b2,b3: byte;
+       end;
+begin
+  clo := CRC.lo32;
+  chi := CRC.hi32;
+  for i:=1 to Len do begin
+    {c64 := Tab64[(c64 shr 56) xor Msg^] xor  (c64 shl 8)}
+    it := BR(chi).b3 xor PByte(Msg)^;  {index in tables}
+    chi := chi shl 8;
+    BR(chi).b0 := BR(clo).b3;
+    chi := chi xor Tab64Hi[it];
+    clo := (clo shl 8) xor Tab64Lo[it];
+    inc(longint(Msg));
+  end;
+  CRC.lo32 := clo;
+  CRC.hi32 := chi;
+end;
+
+{---------------------------------------------------------------------------}
+procedure CRC64Init(var CRC: TCRC64);
+  {-CRC64 initialization}
+begin
+  CRC := Mask64;
+end;
+
+{---------------------------------------------------------------------------}
+procedure CRC64Final(var CRC: TCRC64);
+  {-CRC64: finalize calculation}
+begin
+  CRC.lo32 := CRC.lo32 xor Mask64.lo32;
+  CRC.hi32 := CRC.hi32 xor Mask64.hi32;
+end;
+
+{---------------------------------------------------------------------------}
+procedure CRC64Full(var CRC: TCRC64; Msg: pointer; Len: word);
+  {-CRC64 of Msg with init/update/final}
+begin
+  CRC64Init(CRC);
+  CRC64Update(CRC, Msg, Len);
+  CRC64Final(CRC);
+end;
+
 end.
 
 {
   $Log: crc.pas,v $
+  Revision 1.7  2005/10/07 10:46:14  mw
+  MW: - Hinzufügen von Routinen zur CRC64
+        (Vorbereitung auf Umstellung der Bezugsverkettung auf CRC64)
+
   Revision 1.6  2005/01/01 11:16:27  mw
   MW: - Willkommen im Jahr 2005
 
Index: freexp/Trial/crc64_openxp.diff
===================================================================
RCS file: freexp/Trial/crc64_openxp.diff
diff -N freexp/Trial/crc64_openxp.diff
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ freexp/Trial/crc64_openxp.diff	7 Oct 2005 12:21:22 -0000	1.1
@@ -0,0 +1,579 @@
+Index: crc.pas
+===================================================================
+--- crc.pas	(revision 7024)
++++ crc.pas	(working copy)
+@@ -38,6 +38,8 @@
+ 
+ procedure CRC64Full(var CRC: TCRC64; Msg: pointer; Len: word);    {-CRC64 of Msg with init/update/final}
+ 
++function CRC64Str(s: string): Int64;
++
+ implementation
+ 
+ var
+@@ -234,7 +236,7 @@
+ 
+ (*----------------------------- CRC64 Routinen -----------------------------*)
+ (*--------------------------------------------------------------------------
+- (C) Copyright 2005      Martin Wodrich 
++ (C) Copyright 2005      Martin Wodrich
+ 
+  Modifikation um ohne Assembler-Abschnitte, lange Define-Abschnitte
+  und Includes auszukommen (Erleichtert die Itegration in bestehende
+@@ -290,7 +292,7 @@
+ *************************************************************************)
+ 
+ 
+-const Tab64lo : array[0..255] of longint = (
++const Tab64lo : array[0..255] of Cardinal = (
+     $00000000,    $A9EA3693,    $53D46D26,    $FA3E5BB5,
+     $0E42ECDF,    $A7A8DA4C,    $5D9681F9,    $F47CB76A,
+     $1C85D9BE,    $B56FEF2D,    $4F51B498,    $E6BB820B,
+@@ -356,7 +358,7 @@
+     $3AF9026D,    $931334FE,    $692D6F4B,    $C0C759D8,
+     $34BBEEB2,    $9D51D821,    $676F8394,    $CE85B507);
+ 
+-const Tab64hi : array[0..255] of longint = (
++const Tab64hi : array[0..255] of Cardinal = (
+     $00000000,    $42F0E1EB,    $85E1C3D7,    $C711223C,
+     $49336645,    $0BC387AE,    $CCD2A592,    $8E224479,
+     $9266CC8A,    $D0962D61,    $17870F5D,    $5577EEB6,
+@@ -483,4 +485,15 @@
+   CRC64Final(CRC);
+ end;
+ 
++function CRC64Str(s: string): Int64;
++var
++    CRC: TCRC64;
++begin
++  CRC64Init(CRC);
++  CRC64Update(CRC, @s[1], Length(s));
++  CRC64Final(CRC);
++  // !! Check if result is a 'real' Int64 or the byte order is reversed
++  Result := Int64(CRC);
++end;
++
+ end.
+Index: database.pas
+===================================================================
+--- database.pas	(revision 7024)
++++ database.pas	(working copy)
+@@ -87,6 +87,7 @@
+ function  dbFound:boolean;
+ function  dbIntStr(i:integer16):string;
+ function  dbLongStr(l:longint):string;
++function dbInt64Str(l: Int64):string;
+ 
+ {--------------------------------------------- Daten lesen/schreiben ---}
+ 
+@@ -103,6 +104,7 @@
+ function  dbReadStrN(dbp:DB; feldnr:integer):string;
+ function  dbReadInt(dbp:DB; const feld:dbFeldStr):longint;
+ function  dbReadIntN(dbp:DB; feldnr:integer):longint;
++function  dbReadInt64N(dbp:DB; Feldnr: Integer): Int64;
+ 
+ function  dbXsize  (dbp:DB; const feld:dbFeldStr):longint;
+ procedure dbReadX  (dbp:DB; const feld:dbFeldStr; var size:integer; var data);
+@@ -1192,12 +1194,13 @@
+     if (feldnr<0) or (feldnr>hd.felder) then error('ReadN: ungültige Feldnr.');
+     with feldp^.feld[feldnr] do
+       case ftyp of
+-        1       : begin
++        dbTypeString: begin
+                     bb:=recbuf^[fofs]+1;
+                     if bb>fsize then bb:=fsize;
+                     move(recbuf^[fofs],data,bb);
+                   end;
+-        2,3,4,5 : if (fsize > 0) then
++          dbTypeInt, dbTypeReal, dbTypeDatum,  // dbUntypedExt = 6 fehlt ??
++        dbUntyped, dbTypeInt64: if (fsize > 0) then
+                     move(recbuf^[fofs],data,fsize);
+       end;
+     end;
+@@ -1240,10 +1243,20 @@
+ 
+ function dbReadIntN(dbp:DB; Feldnr: Integer):longint;
+ begin
+-  Result :=0; 
++  Result :=0;
++{$IFDEF Debug }
++  if dp(dbp)^.feldp^.feld[feldnr].ftyp = dbTypeInt64 then
++    raise Exception.Create('Trying to read Int64 with dbReadIntN fails');
++{$ENDIF }
+   dbReadN(dbp,feldnr, Result);   { 1/2/4 Bytes }
+ end;
+ 
++function dbReadInt64N(dbp:DB; Feldnr: Integer): Int64;
++begin
++  Result :=0;
++  dbReadN(dbp,feldnr, Result);   { 8 Bytes }
++end;
++
+ { 'data' in Feld mit Nr. 'feldnr' schreiben }
+ 
+ procedure dbWriteN(dbp:DB; feldnr:integer; const data);
+@@ -1254,13 +1267,14 @@
+     if (feldnr<0) or (feldnr>hd.felder) then error('WriteN: ungültige Feldnr.');
+     with feldp^.feld[feldnr] do
+       case ftyp of
+-        1       : begin
++        dbTypeString: begin
+                     bb:=byte(data)+1;
+                     if bb>fsize then bb:=fsize;
+                     move(data,recbuf^[fofs],bb);
+                     recbuf^[fofs]:=bb-1;
+                   end;
+-        2,3,4,5 : move(data,recbuf^[fofs],fsize);
++        dbTypeInt, dbTypeReal, dbTypeDatum,  // dbUntypedExt = 6 fehlt ??
++        dbUntyped, dbTypeInt64: move(data,recbuf^[fofs],fsize);
+       end;
+     flushed:=false;
+     end;
+Index: xpmaus.pas
+===================================================================
+--- xpmaus.pas	(revision 7024)
++++ xpmaus.pas	(working copy)
+@@ -57,7 +57,8 @@
+ var t,t2 : text;
+     fn, tfn, s, anew, old, msgid, empf : string;
+     stop : boolean;
+-    l    : longint;
++    l  :  Longint;
++    crc: Int64;
+     hdp  : THeader;
+     hds  : longint;
+     f    : file;
+Index: databaso.pas
+===================================================================
+--- databaso.pas	(revision 7024)
++++ databaso.pas	(working copy)
+@@ -123,10 +123,13 @@
+     for i:=1 to felder do begin
+       if flp^.feld[i].ftyp=1 then inc(flp^.feld[i].fsize);
+       case flp^.feld[i].ftyp of
+-        1,2,5 : inc(size,flp^.feld[i].fsize);
+-        3     : inc(size,6);  { Real }
+-        4     : inc(size,4);  { Datum }
+-        6     : begin
++        dbTypeString,
++        dbTypeInt,
++        dbUntyped       : inc(size,flp^.feld[i].fsize);
++        dbTypeReal      : inc(size, 6);
++        dbTypeDatum     : inc(size, 4);
++        dbTypeInt64     : inc(size, 8);
++        dbUntypedExt    : begin
+                   inc(size,8);  { externes Feld: Zeiger + Grösse }
+                   xflag:=true;
+                 end;
+Index: xp4o.inc
+===================================================================
+--- xp4o.inc	(revision 7024)
++++ xp4o.inc	(working copy)
+@@ -459,12 +459,12 @@
+     domove:=true;
+     if dbReadInt(mbase,'netztyp') shr 24>0 then begin   { CrossPosting }
+       rec:=dbRecno(mbase);
+-      mid:=LeftStr(dbReadStrN(mbase,mb_msgid),4);
++      mid:=LeftStr(dbReadStrN(mbase,mb_msgid),8);
+       domove:=not MsgOk;
+       if domove then begin
+         dbSeek(bezbase,beiMsgid,mid);
+         if dbFound then begin
+-          while not dbEOF(bezbase) and (dbLongStr(dbReadIntN(bezbase,bezb_msgid))=mid)
++          while not dbEOF(bezbase) and (dbInt64Str(dbReadInt64N(bezbase,bezb_msgid))=mid)
+           do begin
+             mpos:=dbReadIntN(bezbase,bezb_msgpos);
+             if (mpos<>rec) and not dbDeleted(mbase,mpos) then begin
+Index: xp4w.inc
+===================================================================
+--- xp4w.inc	(revision 7024)
++++ xp4w.inc	(working copy)
+@@ -637,13 +637,14 @@
+       if rflag then begin
+         b:=1;
+         dbWriteN(mbase,mb_gelesen,b);
+-        if dbReadInt(mbase,'netztyp') shr 24<>0 then begin  { Crossposting }
++        if dbReadInt(mbase,'netztyp') shr 24<>0 then
++        begin  { Crossposting }
+           rec:=dbRecno(mbase);
+-          crc:=LeftStr(dbReadStrN(mbase,mb_msgid),4);
++          crc:=LeftStr(dbReadStrN(mbase,mb_msgid),8);
+           mi:=dbGetIndex(bezbase); dbSetIndex(bezbase,beiMsgID);
+           dbSeek(bezbase,beiMsgID,crc);     { alle Kopien auf 'gelesen' }
+           if dbFound then begin
+-            while not dbEOF(bezbase) and (dbLongStr(dbReadIntN(bezbase,bezb_msgid))=crc)
++            while not dbEOF(bezbase) and (dbInt64Str(dbReadInt64N(bezbase,bezb_msgid))=crc)
+             do begin
+               dbReadN(bezbase,bezb_msgpos,rec2);
+               if (rec2<>rec) and not dbDeleted(mbase,rec2) then begin
+Index: databas2.inc
+===================================================================
+--- databas2.inc	(revision 7024)
++++ databas2.inc	(working copy)
+@@ -235,6 +235,15 @@
+   dbLongStr:=s;
+ end;
+ 
++function dbInt64Str(l: Int64):string;
++type ca = array[1..8] of char;
++var s : string[8];
++    i : integer;
++begin
++  s[0]:=#8;
++  for i:=1 to 8 do s[i]:=ca(l)[9-i];
++  dbInt64Str := s;
++end;
+ 
+ { Die Indexversion wird von OpenIndex.CreateIndex }
+ { in den Indexheader geschrieben                  }
+Index: xp1.pas
+===================================================================
+--- xp1.pas	(revision 7024)
++++ xp1.pas	(working copy)
+@@ -198,7 +198,7 @@
+ function  fuser(const s:string):string;              { Spaces vor/hinter '@' }
+ function  aufnahme_string:string;
+ 
+-function  MsgidIndex(mid:string):longint;      { case-insensitive CRC32 }
++function  MsgidIndex(mid:string): Int64 ;      { case-insensitive CRC64 }
+ 
+ function getb(const su, v:string; var b:byte):boolean;   { PARSER }
+ function getc(const su, v:string; var c:char):boolean;
+@@ -1970,9 +1970,9 @@
+   writeln;
+ end;
+ 
+-{ rechten Teil der ID in LowerCase umwandeln und CRC32 bilden }
++{ rechten Teil der ID in LowerCase umwandeln und CRC64 bilden }
+ 
+-function MsgidIndex(mid:string):longint;
++function MsgidIndex(mid:string): Int64;
+ var p : integer;
+ begin
+   p:=cposx('@',mid)+1;
+@@ -1980,7 +1980,7 @@
+     mid[p]:=system.upcase(mid[p]);
+     inc(p);
+     end;
+-  MsgidIndex:=CRC32Str(mid);
++  MsgidIndex:=CRC64Str(mid);
+ end;
+ 
+ const cm = false;
+Index: xp1o.pas
+===================================================================
+--- xp1o.pas	(revision 7024)
++++ xp1o.pas	(working copy)
+@@ -66,7 +66,7 @@
+ procedure AddBezug(var hd:Theader; dateadd:byte);
+ procedure DelBezug;
+ function  GetBezug(const ref:string):longint;
+-procedure AddNewBezug(MsgPos, MsgId, Ref, Datum: Integer);
++procedure AddNewBezug(MsgPos: Integer; MsgId, Ref: Int64; Datum: Integer);
+ { HJT 11.00.05: Reference Normalisieren }
+ function  NormalizeBezug(const ref:string):string;
+ function  KK:boolean;
+@@ -625,7 +625,7 @@
+     UniExtract:=true;
+ end;
+ 
+-procedure AddNewBezug(MsgPos, MsgId, Ref, Datum: Integer);
++procedure AddNewBezug(MsgPos: Integer; MsgId, Ref: Int64; Datum: Integer);
+ begin
+   Debug.DebugLog('xp1o',Format(
+     'adding reference: msg no. %d (id=%4x, refid=%4x, date=%d)',
+@@ -672,7 +672,7 @@
+ end;
+ 
+ procedure AddBezug(var hd:Theader; dateadd:byte);
+-var c1,c2 : longint;
++var c1,c2 : Int64;
+     satz  : longint;
+     datum : longint;
+     empfnr: byte;
+@@ -717,7 +717,7 @@
+ 
+ function HasRef:boolean;
+ begin
+-  dbSeek(bezbase,beiRef,LeftStr(dbReadStrN(mbase,mb_msgid),4));
++  dbSeek(bezbase,beiRef,LeftStr(dbReadStrN(mbase,mb_msgid),8));
+   HasRef:=dbFound;
+ end;
+ 
+@@ -731,7 +731,7 @@
+ 
+   function MidOK:boolean;
+   begin
+-    MidOK:=(dbLongStr(dbReadIntN(bezbase,bezb_msgid))=crc);
++    MidOK:=(dbInt64Str(dbReadInt64N(bezbase,bezb_msgid))=crc);
+   end;
+ 
+   function DatOK:boolean;
+@@ -742,7 +742,7 @@
+ begin
+   if KK then begin
+     pos:=dbRecno(mbase);
+-    crc:=LeftStr(dbReadStrN(mbase,mb_msgid),4);
++    crc:=LeftStr(dbReadStrN(mbase,mb_msgid),8);
+     mi:=dbGetIndex(bezbase); dbSetIndex(bezbase,beiMsgid);
+     dbSeek(bezbase,beiMsgid,crc);
+     ok:=dbfound;
+@@ -772,12 +772,12 @@
+ end;
+ 
+ 
+-function GetBezug(const ref:string):longint;
++function GetBezug(const ref:string): longint;
+ var pos : longint;
+ begin
+   { HJT 11.05.05 Bezug normalisieren }
+   { dbSeek(bezbase,beiMsgid,dbLongStr(MsgidIndex(ref))); }
+-  dbSeek(bezbase,beiMsgid,dbLongStr(MsgidIndex(NormalizeBezug(ref))));
++  dbSeek(bezbase,beiMsgid,dbInt64Str(MsgidIndex(NormalizeBezug(ref))));
+   if dbFound then begin
+     pos:=dbReadIntN(bezbase,bezb_msgpos);
+     dbGo(mbase,pos);
+Index: version.inc
+===================================================================
+--- version.inc	(revision 7024)
++++ version.inc	(working copy)
+@@ -1 +1 @@
+-version_build = 6996;
++version_build = 7022;
+Index: xp3o.inc
+===================================================================
+--- xp3o.inc	(revision 7024)
++++ xp3o.inc	(working copy)
+@@ -220,7 +220,7 @@
+   end;
+ 
+   procedure bearbeiteMsg(var id,abs,sender:string; cancel:boolean);
+-  var crc  : longint;
++  var crc  : Int64;
+       hdp2 : THeader;
+       hds  : longint;
+       rec  : longint;
+@@ -266,9 +266,9 @@
+     crc:=MsgidIndex(id);
+     hdp2 := THeader.Create;
+     if cancel then mrec:=dbRecno(mbase); { Position der Cancel-Mail merken }
+-    dbSeek(bezbase,beiMsgId,dbLongStr(crc));
++    dbSeek(bezbase,beiMsgId,dbInt64Str(crc));
+     if dbFound then
+-      while (not dbEOF(bezbase)) and (dbReadIntN(bezbase,bezb_msgid)=crc) do begin
++      while (not dbEOF(bezbase)) and (dbReadInt64N(bezbase,bezb_msgid)=crc) do begin
+         repeat;
+           hdp2.msgid:='';
+           rec:=dbReadIntN(bezbase,bezb_msgpos);
+@@ -277,7 +277,7 @@
+             Readheader(hdp2,hds,false);
+           end;
+           dbNext(bezbase);
+-        until (hdp2.msgid=id) or dbEOF(bezbase) or (dbReadIntN(bezbase,bezb_msgid)<>crc);
++        until (hdp2.msgid=id) or dbEOF(bezbase) or (dbReadInt64N(bezbase,bezb_msgid)<>crc);
+         { HJT 10.09.05, die ausloesende ERSETZT-Nachricht nicht auf loeschen setzen }
+         { if okay then DelMsg; } { zu löschende/zu ersetzende Nachricht löschen }
+         if okay and (cancel or (hdp2.msgid <> hdp2.ersetzt)) then DelMsg; { zu löschende/zu ersetzende Nachricht löschen }
+@@ -644,7 +644,7 @@
+     MsgPos: Integer;
+   begin
+     result:= false;
+-    dbSeek(bezbase,beiMsgID,dbLongStr(MsgidIndex(Hdp.msgid)));
++    dbSeek(bezbase,beiMsgID,dbInt64Str(MsgidIndex(Hdp.msgid)));
+     if dbFound and not dbDeleted(bezbase, dbRecNo(bezbase)) then
+     begin
+       // message with same msgid found in db
+Index: xp2db.pas
+===================================================================
+--- xp2db.pas	(revision 7024)
++++ xp2db.pas	(working copy)
+@@ -875,8 +875,8 @@
+   if not FileExists(BezugFile+dbExt) then begin       { BEZUEGE: Kommentarbaum }
+     initflp(4);
+     AppX('MsgPos',dbTypeInt,4,10);
+-    AppX('MsgID',dbTypeInt,4,10);
+-    AppX('Ref',dbTypeInt,4,10);
++    AppX('MsgID',dbTypeInt64,8,10);
++    AppX('Ref',dbTypeInt64,8,10);
+     AppX('Datum',dbTypeInt,4,10);
+     dbCreate(BezugFile,flp);
+     dbReleaseFL(flp);
+Index: datadef.pas
+===================================================================
+--- datadef.pas	(revision 7024)
++++ datadef.pas	(working copy)
+@@ -49,6 +49,7 @@
+         dbTypeDatum   = 4;    { Datum 4 Bytes t/m/jj  ==  LongInt         }
+         dbUntyped     = 5;    { untypisiert, feste Länge                  }
+         dbUntypedExt  = 6;    { bis 32K Länge, 4Byte-Zeiger auf DBD-File  }
++        dbTypeInt64   = 7;    { 64 Bit Integer                            }
+ 
+         dbFlagIndexed = 1;    { Flag für dbOpen }
+ 
+Index: xpsendmessage_unsent.pas
+===================================================================
+--- xpsendmessage_unsent.pas	(revision 7024)
++++ xpsendmessage_unsent.pas	(working copy)
+@@ -311,9 +311,9 @@
+   if empfnr>0 then begin
+     dbReadN(mbase,mb_ablage,ablage);    { alle Crosspostings auf loe. + !UV }
+     dbReadN(mbase,mb_adresse,madr);
+-    crc:=LeftStr(dbReadStrN(mbase,mb_msgid),4);
++    crc:=LeftStr(dbReadStrN(mbase,mb_msgid),8);
+     dbSeek(bezbase,beiMsgID,crc);
+-    while not dbEOF(bezbase) and (dbLongStr(dbReadIntN(bezbase,bezb_msgid))=crc) do begin
++    while not dbEOF(bezbase) and (dbInt64Str(dbReadInt64N(bezbase,bezb_msgid))=crc) do begin
+       if dbReadIntN(bezbase,bezb_msgpos)<>rec then begin
+         dbGo(mbase,dbReadIntN(bezbase,bezb_msgpos));
+         if (dbReadInt(mbase,'ablage')=ablage) and (dbReadInt(mbase,'adresse')=madr) then
+Index: xp4o2.pas
+===================================================================
+--- xp4o2.pas	(revision 7024)
++++ xp4o2.pas	(working copy)
+@@ -281,11 +281,12 @@
+   end;
+ 
+   function BezNr:byte;      { 1 = erster Crossposting-Empfänger, sonst 2 }
+-  var mcrc,dat : longint;
++  var mcrc: Int64;
++      dat : longint;
+       nr       : byte;
+   begin
+     mcrc:=MsgidIndex(hd.msgid);
+-    dbSeek(bezbase,beiMsgID,dbLongStr(mcrc));
++    dbSeek(bezbase,beiMsgID,dbInt64Str(mcrc));
+     if not dbFound then
+       BezNr:=1
+     else begin
+@@ -305,7 +306,7 @@
+               end;
+           end;
+         dbNext(bezbase);
+-      until (nr<>0) or dbEOF(bezbase) or (dbReadIntN(bezbase,bezb_msgid)<>mcrc);
++      until (nr<>0) or dbEOF(bezbase) or (dbReadInt64N(bezbase,bezb_msgid)<>mcrc);
+       BezNr:=nr;
+       end;
+   end;
+@@ -402,7 +403,7 @@
+     bez,n  : longint;
+     mi     : shortint;
+     brett  : string;
+-    nullid : longint;
++    nullid : Int64;
+     xlines : kommLines;
+ 
+   procedure RecurBez(ebene: Integer; rec: LongInt; Spuren: KommLines; last:boolean;
+@@ -413,8 +414,8 @@
+                   dat : longint;
+                 end;
+         blist = array[1..bmax] of brec;
+-  var id     : longint;
+-      ida    : array[0..3] of char absolute id;
++  var id     : Int64;
++      ida    : array[0..7] of char absolute id;
+       ba,ba2 : ^blist;
+       anz    : longint;
+       i,j    : integer;
+@@ -423,7 +424,7 @@
+       newbetr: string;
+       _brett : string;
+       r      : brec;
+-      mid    : longint;
++      mid    : Int64;
+       spnr,
+       spb    : Cardinal;
+ 
+@@ -461,24 +462,24 @@
+       if nullid=0 then
+         mid:= dbReadNStr(mbase,mb_msgid)
+       else begin
+-        mid:=dbLongStr(nullid); nullid:=0;
++        mid:=dbInt64Str(nullid); nullid:=0;
+         end;
+-      if Length(mid) >=4 then
++      if Length(mid) >=8 then
+       begin
+-        dbSeek(bezbase,beiRef,LeftStr(mid,4));
+-        for i:=0 to 3 do
+-          ida[i]:=mid[4-i];
++        dbSeek(bezbase,beiRef,LeftStr(mid,8));
++        for i:=0 to 7 do
++          ida[i]:=mid[8-i];
+         end;
+     end;
+ 
+     function _last:boolean;
+     begin
+-      _last:=dbEOF(bezbase) or (dbReadIntN(bezbase,bezb_ref)<>ID);
++      _last:=dbEOF(bezbase) or (dbReadInt64N(bezbase,bezb_ref)<>ID);
+     end;
+ 
+     procedure AddD0;     { erste (noch) vorhandene Kopie hinzufügen }
+-    begin
+-      while not _last and (dbReadIntN(bezbase,bezb_msgid)=mid) do begin
++    begin                                                                                                             q
++      while not _last and (dbReadInt64N(bezbase,bezb_msgid)=mid) do begin
+         if dbReadIntN(bezbase,bezb_datum) and 3<>2 then begin
+           inc(anz);
+           dbReadN(bezbase,bezb_msgpos,ba^[anz].pos);
+@@ -494,7 +495,7 @@
+     begin
+       rec:=dbRecno(bezbase);
+       found:=false;
+-      while not _last and (dbReadIntN(bezbase,bezb_msgid)=mid) do begin
++      while not _last and (dbReadInt64N(bezbase,bezb_msgid)=mid) do begin
+         dbReadN(bezbase,bezb_msgpos,rec2);
+         if not found and not dbDeleted(mbase,rec2) then begin
+           dbGo(mbase,rec2);
+@@ -524,7 +525,7 @@
+           getmem(ba,sizeof(brec)*bmax);
+           anz:=0;
+           while not _last and (anz<bmax) do begin
+-            dbReadN(bezbase,bezb_msgid, mid);
++            mid := dbReadInt64N(bezbase,bezb_msgid);
+             if dbReadIntN(bezbase,bezb_datum) and 3=0 then
+               AddD0
+             else
+@@ -685,7 +686,7 @@
+   BezSeekKommentar:=false;
+   mi:=dbGetIndex(bezbase);
+   dbSetIndex(bezbase,beiRef);
+-  mid:=LeftStr(dbReadStrN(mbase,mb_msgid),4);
++  mid:=LeftStr(dbReadStrN(mbase,mb_msgid),8);
+   dbSeek(bezbase,beiRef,mid);
+   if dbFound then begin
+     dbReadN(bezbase,bezb_ref,ref);
+@@ -710,7 +711,8 @@
+ var hdp      : theader;
+     hds      : longint;
+     rec,dat  : longint;
+-    ref,dat0 : longint;
++    Ref:     Int64;
++    dat0 : longint;
+     mi       : shortint;
+     vor      : boolean;
+ begin
+@@ -723,12 +725,12 @@
+   if hds>1 then
+   begin
+     up:=(hdp.References.Count > 0);
+-    dbSeek(bezbase,beiRef,LeftStr(dbReadStrN(mbase,mb_msgid),4));
++    dbSeek(bezbase,beiRef,LeftStr(dbReadStrN(mbase,mb_msgid),8));
+     down:=dbFound;
+     if hdp.References.Count > 0 then
+     begin
+       ref:=MsgidIndex(hdp.GetLastReference);
+-      dbSeek(bezbase,beiRef,dbLongStr(ref));
++      dbSeek(bezbase,beiRef,dbInt64Str(ref));
+       if dbFound then begin
+         vor:=true;
+         dbReadN(bezbase,bezb_ref,ref);
+@@ -742,7 +744,7 @@
+             if smdl(dat0,dat) or (not vor and (dat=dat0)) then _right:=true;
+             end;
+           dbSkip(bezbase,1);
+-        until dbEOF(bezbase) or (dbReadIntN(bezbase,bezb_ref)<>ref) or
++        until dbEOF(bezbase) or (dbReadInt64N(bezbase,bezb_ref)<>ref) or
+               (_left and _right);
+         end;
+       end;
Index: freexp/Trial/xp_ntvdm.dll
===================================================================
RCS file: freexp/Trial/xp_ntvdm.dll
diff -N freexp/Trial/xp_ntvdm.dll
Binary files /tmp/cvsmxSBxJ and /dev/null differ
Index: freexp/Trial/xp_ntvdm.pas
===================================================================
RCS file: freexp/Trial/xp_ntvdm.pas
diff -N freexp/Trial/xp_ntvdm.pas
--- freexp/Trial/xp_ntvdm.pas	28 May 2005 11:57:13 -0000	1.1
+++ /dev/null	1 Jan 1970 00:00:00 -0000
@@ -1,375 +0,0 @@
-{ --------------------------------------------------------------- }
-{ Dieser Quelltext ist urheberrechtlich geschuetzt.               }
-{ (c) 2000-2001 OpenXP-Team & Claus Faerber                       }
-{ (c) 2002-2005 FreeXP, http://www.freexp.de                      }
-{ CrossPoint ist eine eingetragene Marke von Peter Mandrella.     }
-{                                                                 }
-{ Die Nutzungsbedingungen fuer diesen Quelltext finden Sie in der }
-{ Datei SLIZENZ.TXT oder auf www.crosspoint.de/oldlicense.html.   }
-{ --------------------------------------------------------------- }
-{ $Id: xp_ntvdm.pas,v 1.1 2005/05/28 11:57:13 mw Exp $            }
-
-Library xp_ntvdm;
-
-uses windows,dos,strings;
-
-const xp_ntvdm_version=$2;
-      xp_simdisk=1234567890;
-
-var   SecurityAttributes: LPSECURITY_ATTRIBUTES;
-      Over: POVERLAPPED;
-
-{ --- Imports from ntvdm.exe ------------------------------------ }
-
-  procedure setEAX(para:ULONG);  external 'ntvdm.exe';   { function getEAX:ULONG; external 'ntvdm.exe'; }
-{ procedure setAX(para:USHORT);  external 'ntvdm.exe'; } { function getAX:USHORT; external 'ntvdm.exe'; }
-{ procedure setAL(para:UCHAR);   external 'ntvdm.exe'; } { function getAL:UCHAR;  external 'ntvdm.exe'; }
-{ procedure setAH(para:UCHAR);   external 'ntvdm.exe'; } { function getAH:UCHAR;  external 'ntvdm.exe'; }
-
-{ procedure setEBX(para:ULONG);  external 'ntvdm.exe'; } { function getEBX:ULONG; external 'ntvdm.exe'; }
-{ procedure setBX(para:USHORT);  external 'ntvdm.exe'; } { function getBX:USHORT; external 'ntvdm.exe'; }
-{ procedure setBL(para:UCHAR);   external 'ntvdm.exe'; } { function getBL:UCHAR;  external 'ntvdm.exe'; }
-{ procedure setBH(para:UCHAR);   external 'ntvdm.exe'; } { function getBH:UCHAR;  external 'ntvdm.exe'; }
-
-{ procedure setECX(para:ULONG);  external 'ntvdm.exe'; }   function getECX:ULONG; external 'ntvdm.exe';
-{ procedure setCX(para:USHORT);  external 'ntvdm.exe'; } { function getCX:USHORT; external 'ntvdm.exe'; }
-{ procedure setCL(para:UCHAR);   external 'ntvdm.exe'; }   function getCL:UCHAR;  external 'ntvdm.exe';
-{ procedure setCH(para:UCHAR);   external 'ntvdm.exe'; }   function getCH:UCHAR;  external 'ntvdm.exe';
-
-{ procedure setEDX(para:ULONG);  external 'ntvdm.exe'; } { function getEDX:ULONG; external 'ntvdm.exe'; }
-{ procedure setDX(para:USHORT);  external 'ntvdm.exe'; }   function getDX:USHORT; external 'ntvdm.exe';
-{ procedure setDH(para:UCHAR);   external 'ntvdm.exe'; } { function getDH:UCHAR;  external 'ntvdm.exe'; }
-{ procedure setDL(para:UCHAR);   external 'ntvdm.exe'; } { function getDL:UCHAR;  external 'ntvdm.exe'; }
-
-{ procedure setESP(para:ULONG);  external 'ntvdm.exe'; } { function getESP:ULONG; external 'ntvdm.exe'; }
-{ procedure setSP(para:USHORT);  external 'ntvdm.exe'; } { function getSP:USHORT; external 'ntvdm.exe'; }
-
-{ procedure setEBP(para:ULONG);  external 'ntvdm.exe'; } { function getEBP:ULONG; external 'ntvdm.exe'; }
-{ procedure setBP(para:USHORT);  external 'ntvdm.exe'; } { function getBP:USHORT; external 'ntvdm.exe'; }
-
-{ procedure setESI(para:ULONG);  external 'ntvdm.exe'; }   function getESI:ULONG; external 'ntvdm.exe';
-{ procedure setSI(para:USHORT);  external 'ntvdm.exe'; } { function getSI:USHORT; external 'ntvdm.exe'; }
-
-{ procedure setEDI(para:ULONG);  external 'ntvdm.exe'; }   function getEDI:ULONG; external 'ntvdm.exe';
-{ procedure setDI(para:USHORT);  external 'ntvdm.exe'; } { function getDI:USHORT; external 'ntvdm.exe'; }
-
-{ procedure setEIP(para:ULONG);  external 'ntvdm.exe'; } { function getEIP:ULONG; external 'ntvdm.exe'; }
-{ procedure setIP(para:USHORT);  external 'ntvdm.exe'; } { function getIP:USHORT; external 'ntvdm.exe'; }
-
-{ procedure setCS(para:USHORT);  external 'ntvdm.exe'; } { function getCS:USHORT; external 'ntvdm.exe'; }
-{ procedure setSS(para:USHORT);  external 'ntvdm.exe'; } { function getSS:USHORT; external 'ntvdm.exe'; }
-{ procedure setDS(para:USHORT);  external 'ntvdm.exe'; } { function getDS:USHORT; external 'ntvdm.exe'; }
-{ procedure setES(para:USHORT);  external 'ntvdm.exe'; } { function getES:USHORT; external 'ntvdm.exe'; }
-{ procedure setFS(para:USHORT);  external 'ntvdm.exe'; } { function getFS:USHORT; external 'ntvdm.exe'; }
-{ procedure setGS(para:USHORT);  external 'ntvdm.exe'; } { function getGS:USHORT; external 'ntvdm.exe'; }
-
-  procedure setCF(para:ULONG);   external 'ntvdm.exe';   { function getCF:ULONG;  external 'ntvdm.exe'; }
-{ procedure setPF(para:ULONG);   external 'ntvdm.exe'; } { function getPF:ULONG;  external 'ntvdm.exe'; }
-{ procedure setAF(para:ULONG);   external 'ntvdm.exe'; } { function getAF:ULONG;  external 'ntvdm.exe'; }
-{ procedure setZF(para:ULONG);   external 'ntvdm.exe'; } { function getZF:ULONG;  external 'ntvdm.exe'; }
-{ procedure setSF(para:ULONG);   external 'ntvdm.exe'; } { function getSF:ULONG;  external 'ntvdm.exe'; }
-{ procedure setIF(para:ULONG);   external 'ntvdm.exe'; } { function getIF:ULONG;  external 'ntvdm.exe'; }
-
-{ procedure setDF(para:ULONG);   external 'ntvdm.exe';  }
-{ procedure setOF(para:ULONG);   external 'ntvdm.exe';  }
-{ procedure setMSW(para:USHORT); external 'ntvdm.exe';  }
-
-function  GetVDMAddress(Address,Size:ULONG; ProtectedMode:BOOL):Pointer; external 'ntvdm.exe' name 'MGetVdmPointer';
-function  FreeVDMPointer(Address:ULONG; Size:USHORT; Buffer:Pointer; ProtectedMode:BOOL):BOOL; begin FreeVDMPointer := true; end;
-
-{ --- Exact Windows Version ------------------------------------- }
-
-procedure get_windows_version;
-begin
-  setEAX(GetVersion);
-end;
-
-{ --- Clipboard functions --------------------------------------- }
-
-procedure clip_to_string;
-var maxlen:  integer;
-    len:     integer;
-    i:             integer;
-    oneline: boolean;
-    sp:      ^shortstring;
-    ch:             HANDLE;
-    cp:             PChar;
-begin
-  maxlen := getCL;
-  oneline:= getCH<>0;
-  sp := GetVDMAddress(GetEDI,maxlen,false);
-  setCF(1);
-
-  OpenClipboard(0);
-  ch := GetClipboardData(CF_OEMTEXT);
-  if ch<> 0 then
-  begin
-    cp := GlobalLock(ch);
-    if cp <> nil then
-    begin
-      len := StrLen(cp);
-      if len>255    then len:=255;
-      if len>maxlen then len:=maxlen;
-      MoveMemory(PChar(Pointer(sp))+1,cp,len);
-      sp^[0]:=Char(Byte(len));
-    end;
-    if oneline then
-      for i:=1 to len do
-        if sp^[i]<#32 then
-          sp^[i]:=#32;
-    setCF(0);
-
-    GlobalUnlock(ch);
-  end;
-  CloseClipboard;
-
-  FreeVDMPointer(GetEDI,maxlen,sp,false);
-end;
-
-procedure mem_to_clip;
-var         cp: PChar;
-        cl: ULONG;
-        hm: HANDLE;
-        pm: PChar;
-begin
-  cl := GetECX;
-  cp := GetVDMAddress(GetESI,cl,false);
-
-  SetCF(1);
-
-  if OpenClipboard(0) then
-  begin
-    hm := GlobalAlloc(GMEM_MOVEABLE,cl+1);
-    if hm <> 0 then
-    begin
-      pm := GlobalLock(hm);
-      if pm <> nil then
-      begin
-        MoveMemory(pm,cp,cl);
-        (PChar(pm)+cl)^ := #0;
-        GlobalUnLock(hm);
-
-        EmptyClipboard;
-        SetClipboardData(CF_OEMTEXT,hm);
-        SetCF(0);
-      end;
-    end;
-    CloseClipboard;
-  end;
-
-  FreeVDMPointer(GetESI,cl,cp,false);
-end;
-
-procedure clip_to_file;
-var        fn: PChar;
-        fh: Handle;
-        ch: Handle;
-        cp: LPTSTR;
-        wr: DWORD;
-begin
-  fn:=GetVDMAddress(GetESI,$10000,false);
-  setCF(1);
-
-  OpenClipboard(0);
-  ch := GetClipboardData(CF_OEMTEXT);
-  if ch<> 0 then
-  begin
-    cp := GlobalLock(ch);
-    if cp <> nil then
-    begin
-      fh:=CreateFile(fn,GENERIC_WRITE,0,SecurityAttributes,CREATE_ALWAYS,
-        FILE_FLAG_SEQUENTIAL_SCAN,0);
-      if fh<>INVALID_HANDLE_VALUE then
-      begin
-        WriteFile(fh,cp^,StrLen(cp),wr,Over);
-        CloseHandle(fh);
-        setCF(0);
-      end;
-      GlobalUnlock(ch);
-    end;
-  end;
-  CloseClipboard;
-
-  FreeVDMPointer(GetESI,0,fn,false);
-end;
-
-procedure file_to_clip;
-var        fn: PChar;
-        fh: Handle;
-        ln: DWORD;
-        mh: HANDLE;
-        mp: PChar;
-begin
-  fn:=GetVDMAddress(GetESI,$10000,false);
-  setCF(1);
-
-  fh:=CreateFile(fn,GENERIC_READ,0,SecurityAttributes,OPEN_EXISTING,
-    FILE_FLAG_SEQUENTIAL_SCAN,0);
-  if fh<>INVALID_HANDLE_VALUE then
-  begin
-    ln := GetFileSize(fh,nil);
-    mh := GlobalAlloc(GMEM_MOVEABLE,ln+1);
-    if mh <> 0 then
-    begin
-      mp := GlobalLock(mh);
-      if mp <> nil then
-      begin
-        ReadFile(fh,mp^,ln,ln,nil);
-        (PChar(mp)+ln)^ := #0;
-        GlobalUnlock(mh);
-
-        if OpenClipboard(0) then
-        begin
-          EmptyClipboard;
-            SetClipboardData(CF_OEMTEXT,mh);
-          CloseClipboard;
-        end;
-        setCF(0);
-      end else
-        GlobalFree(mh);
-    CloseHandle(fh);
-    end;
-  end;
-
-  FreeVDMPointer(GetESI,0,fn,false);
-end;
-
-{ --- Calls for DiskFree/DiskSize ------------------------------- }
-procedure NTDiskFree;
-var a:longint;
-    b:integer;
-begin
-  b:=GetCL;
-  a:=(DiskFree(b) DIV 1048576);
-  SetEAX(a);
-end;
-
-procedure NTDiskSize;
-var a:longint;
-    b:integer;
-begin
-  b:=GetCL;
-  a:=(DiskSize(b) DIV 1048576);
-  SetEAX(a);
-end;
-
-procedure SimDisk;
-begin
-  SetEAX(xp_simdisk);
-end;
-
-{ --- NTDiskType ------------------------------------------------ }
-procedure NTDiskType;
-var p :pchar;
-begin
-  p:=Stralloc(4);
-  StrPCopy(p,chr(GetCL+64)+':\');
-  SetEAX(GetDriveTypeA(p));
-end;
-
-{ --- XP_NTVDM_VER ---------------------------------------------- }
-procedure XP_NTVDM_VER;
-begin
-  SetEAX(xp_ntvdm_version);
-end;
-
-{ --- VDD calls ------------------------------------------------- }
-
-procedure FREEXP_CALL; stdcall; export;
-begin
-  case getDX of
-    {Versionsinfos}
-    $0000: get_windows_version;
-    $0001: XP_NTVDM_VER;
-    {Clipboardfunktionen}
-    $0101: clip_to_string;
-    $0102: mem_to_clip;
-    $0103: clip_to_file;
-    $0104: file_to_clip;
-    {Datentraegerfunktionen}
-    $0200: NTDiskFree;
-    $0201: NTDiskSize;
-    $0202: SimDisk;
-    $0203: NTDiskType;
-  end;
-end;
-
-procedure FREEXP_INIT; stdcall; export;
-begin
-end;
-
-{ --- DLL exports ----------------------------------------------- }
-
-exports FREEXP_INIT;
-exports FREEXP_CALL;
-
-end.
-
-{
-  $Log: xp_ntvdm.pas,v $
-  Revision 1.1  2005/05/28 11:57:13  mw
-  MW: - XP_NTVDM muß an FPC 2.0 angepasst werden.
-
-  Revision 1.10  2005/05/28 09:25:45  mw
-  MW: - Anpassung an FreePascal 2.0 (kleine Ungenauigkeiten werden bei
-        FPC 2.0 nicht mehr verziehen).
-
-  Revision 1.9  2005/01/01 11:16:31  mw
-  MW: - Willkommen im Jahr 2005
-
-  Revision 1.8  2004/01/09 16:18:59  mw
-  MW: - Wir haben jetzt 2004!!
-
-  Revision 1.7  2003/08/30 08:56:39  mw
-  MW: - Fehler im letzten Commit korregiert.
-
-  Revision 1.6  2003/08/30 08:42:49  mw
-  MW: - Neue RAM-Disk-Erkennung für WinNT eingebaut.
-        Via XP_NTVDM.DLL (also Win32-API) wird jetzt festgestellt,
-        ob es eine RAM-Disk ist.
-
-  Revision 1.5  2003/08/18 07:30:57  mw
-  MW: - Vervollständigung von NTDiskFree/NTDiskSize
-      - XP_NTVDM hat jetzt eine Revisionsnummer
-      - Simdisk erlaubt Tests der Rechnereien zur schönen Anzeige
-        der ermittelten Werte bei beliebig großen Platten
-      - OPENXP_CALL/OPENXP_INIT heißt jetzt FREEXP_CALL/FREEXP_INIT
-
-  Revision 1.4  2003/08/17 22:19:18  mw
-  MW: - neue Funktionen NTDiskFree/NTDiskSize (zeigen korrekte Diskettengröße
-        unter WinNT an).
-        Achtung: Derzeit nur bis 64 GB und noch nich unbedingt korrekt
-                 formatiert.
-
-  Revision 1.3  2003/07/30 23:09:50  my
-  MY:- Source-Header auf "FreeXP" aktualisiert, einige Detailkorrekturen
-       an CVS-Logs vorgenommen und hier und da CVS-Loginfos implementiert.
-
-  Revision 1.2  2003/06/25 17:29:56  tw
-  auto-de-branching
-
-  Revision 1.1.2.8  2003/03/01 16:55:59  cl
-  - fixed last commit
-
-  Revision 1.1.2.7  2003/03/01 16:28:46  cl
-  - next try for xp_ntvdm.dll
-
-  Revision 1.1.2.6  2002/04/12 14:52:07  cl
-  - removed sysutils unit
-
-  Revision 1.1.2.5  2002/04/12 14:50:11  cl
-  - fixed GetVDMAddress
-  - fixed mem_to_clip (called by String2Clip)
-
-  Revision 1.1.2.4  2001/07/18 20:13:19  cl
-  - removed unnecessary imports from NTVDM.EXE
-
-  Revision 1.1.2.3  2001/07/04 01:33:12  my
-  - changed ANSI-Umlaut to ASCII-Umlaut (please no ANSI, guys :-))
-
-  Revision 1.1.2.2  2001/07/02 21:11:09  mk
-  - removed unused units
-
-  Revision 1.1.2.1  2001/07/02 20:43:04  mk
-  - NTVDM Interface
-}  
\ No newline at end of file



Mehr Informationen über die CVS-List Mailingliste