Menu
▾
▴
win32forth-cvs — CVS Commit List
You can subscribe to this list here.
| 2004 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
(70) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2005 |
Jan
(38) |
Feb
(4) |
Mar
(11) |
Apr
(49) |
May
(81) |
Jun
(65) |
Jul
(36) |
Aug
(57) |
Sep
(63) |
Oct
(57) |
Nov
(49) |
Dec
(41) |
| 2006 |
Jan
(75) |
Feb
(80) |
Mar
(10) |
Apr
(13) |
May
(100) |
Jun
(100) |
Jul
(77) |
Aug
(87) |
Sep
(80) |
Oct
(124) |
Nov
(39) |
Dec
(41) |
| 2007 |
Jan
(20) |
Feb
(32) |
Mar
(32) |
Apr
(43) |
May
(146) |
Jun
(40) |
Jul
(49) |
Aug
(33) |
Sep
(25) |
Oct
(19) |
Nov
(11) |
Dec
(8) |
| 2008 |
Jan
(4) |
Feb
(11) |
Mar
(31) |
Apr
(40) |
May
(34) |
Jun
(24) |
Jul
(39) |
Aug
(104) |
Sep
(27) |
Oct
(35) |
Nov
(34) |
Dec
(97) |
| 2009 |
Jan
(75) |
Feb
(29) |
Mar
(45) |
Apr
(76) |
May
(121) |
Jun
(103) |
Jul
(67) |
Aug
(28) |
Sep
(22) |
Oct
(39) |
Nov
(9) |
Dec
(15) |
| 2010 |
Jan
(7) |
Feb
(39) |
Mar
(40) |
Apr
(57) |
May
(67) |
Jun
(69) |
Jul
(49) |
Aug
(68) |
Sep
(22) |
Oct
(7) |
Nov
(2) |
Dec
(10) |
| 2011 |
Jan
|
Feb
|
Mar
(10) |
Apr
(4) |
May
(6) |
Jun
(10) |
Jul
(16) |
Aug
(23) |
Sep
(9) |
Oct
|
Nov
(28) |
Dec
(3) |
| 2012 |
Jan
(11) |
Feb
(10) |
Mar
(1) |
Apr
|
May
(4) |
Jun
(3) |
Jul
(3) |
Aug
(4) |
Sep
(2) |
Oct
|
Nov
|
Dec
(1) |
| 2013 |
Jan
|
Feb
(7) |
Mar
(30) |
Apr
(4) |
May
(4) |
Jun
(8) |
Jul
(10) |
Aug
(4) |
Sep
|
Oct
(2) |
Nov
(24) |
Dec
(13) |
| 2014 |
Jan
(7) |
Feb
(2) |
Mar
|
Apr
(1) |
May
(9) |
Jun
|
Jul
(3) |
Aug
(9) |
Sep
|
Oct
(2) |
Nov
|
Dec
(3) |
| 2015 |
Jan
(4) |
Feb
(2) |
Mar
|
Apr
|
May
|
Jun
(1) |
Jul
|
Aug
(5) |
Sep
(1) |
Oct
(4) |
Nov
(7) |
Dec
(39) |
| 2016 |
Jan
(17) |
Feb
(2) |
Mar
(2) |
Apr
|
May
(1) |
Jun
(1) |
Jul
|
Aug
|
Sep
|
Oct
|
Nov
(1) |
Dec
(2) |
| 2017 |
Jan
|
Feb
(3) |
Mar
|
Apr
|
May
(1) |
Jun
(2) |
Jul
|
Aug
(3) |
Sep
|
Oct
|
Nov
|
Dec
(2) |
| 2018 |
Jan
|
Feb
|
Mar
(2) |
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2019 |
Jan
|
Feb
|
Mar
(1) |
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2022 |
Jan
|
Feb
|
Mar
|
Apr
|
May
(1) |
Jun
|
Jul
|
Aug
|
Sep
(1) |
Oct
(2) |
Nov
(1) |
Dec
(1) |
| 2023 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
(1) |
Sep
|
Oct
(1) |
Nov
|
Dec
|
| 2025 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
(1) |
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
|
From: George H. <geo...@us...> - 2006-08-25 12:54:08
|
Update of /cvsroot/win32forth/win32forth In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv4195/win32forth Modified Files: fkernel.exe Log Message: gah:Updated documentation and tidy up. Index: fkernel.exe =================================================================== RCS file: /cvsroot/win32forth/win32forth/fkernel.exe,v retrieving revision 1.35 retrieving revision 1.36 diff -C2 -d -r1.35 -r1.36 Binary files /tmp/cvsl7jQ2n and /tmp/cvsRJ4T4q differ |
|
From: George H. <geo...@us...> - 2006-08-25 12:54:08
|
Update of /cvsroot/win32forth/win32forth-610old/htm In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv4195/win32forth-610old/htm Modified Files: p-relnotes.6.10.htm Log Message: gah:Updated documentation and tidy up. Index: p-relnotes.6.10.htm =================================================================== RCS file: /cvsroot/win32forth/win32forth-610old/htm/p-relnotes.6.10.htm,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** p-relnotes.6.10.htm 10 Feb 2006 11:07:55 -0000 1.4 --- p-relnotes.6.10.htm 25 Aug 2006 12:54:00 -0000 1.5 *************** *** 89,95 **** <p>The <a href="p-index.htm">documentation</a> has been beefed up considerably, and is now almost all HTML based. </p> ! <p>Professor Julian V Noble has kindly allowed us to distribute his ! <a href="BeginnersGuideToForth/primer.htm">"A Beginner's Guide to Forth"</a> and some of his ! <a href="BeginnersGuideToForth">formula translation source code</a>. <a href="http://www.complang.tuwien.ac.at/anton/home.html">Anton Ertl</a> <img border="0" src="ONWEB.gif" width="16" height="16"> has given his permission --- 89,96 ---- <p>The <a href="p-index.htm">documentation</a> has been beefed up considerably, and is now almost all HTML based. </p> ! <p>Professor <a href="http://galileo.phys.virginia.edu/~jvn/">Julian V. Noble ! <img border="0" src="ONWEB.gif" width="16" height="16"></a> has kindly allowed us ! to distribute his <a href="Guide/primer.htm">"A Beginner's Guide to Forth"</a> ! and some of his <a href="Guide">formula translation source code</a>. <a href="http://www.complang.tuwien.ac.at/anton/home.html">Anton Ertl</a> <img border="0" src="ONWEB.gif" width="16" height="16"> has given his permission *************** *** 143,151 **** to print 4,000,000 spaces if the line has a comment has been fixed..</p> <p><b> REPRESENT </b> has been modified so zero is output as 0.0e0 by <b>FS.</b> </p> <h2>New Applications</h2> <ul> ! <li><a href="SciEdit.htm">SciEdit</a> (Win32Forth Source-Editor)</li> ! <li><a href="ProjectManager.htm">ForthProject</a> (Win32Forth Project Manager)</li> </ul> --- 144,154 ---- to print 4,000,000 spaces if the line has a comment has been fixed..</p> <p><b> REPRESENT </b> has been modified so zero is output as 0.0e0 by <b>FS.</b> </p> + <p><b> SYNONYM </b> now leaves the new name as hidden if the old name + isn't found. Also it correctly finds an earlier version of old name (if it's in the search order) where the two names are the same and the current and context vocabularies are also the same. </p> <h2>New Applications</h2> <ul> ! <li><a href="SciEdit/SciEdit.htm">SciEdit</a> (Win32Forth Source-Editor)</li> ! <li><a href="ProMgr/ProjectManager.htm">ForthProject</a> (Win32Forth Project Manager)</li> </ul> |
|
From: George H. <geo...@us...> - 2006-08-25 12:54:08
|
Update of /cvsroot/win32forth/win32forth/src/kernel In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv4195/win32forth/src/kernel Modified Files: fkernel.f Log Message: gah:Updated documentation and tidy up. Index: fkernel.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/kernel/fkernel.f,v retrieving revision 1.35 retrieving revision 1.36 diff -C2 -d -r1.35 -r1.36 *** fkernel.f 24 Aug 2006 11:35:09 -0000 1.35 --- fkernel.f 25 Aug 2006 12:54:02 -0000 1.36 *************** *** 4300,4304 **** --- 4300,4306 ---- 0 value slfactor \ adjust this to slow down loading + : SLOW ( -- ) slfactor ms start/stop ; \ set 'slfactor' to slow down loading + : HEADER ( -<name>- ) \ build a header BL WORD COUNT (HEADER) slow ; \ self-call the header word *************** *** 4306,4321 **** in-system ! \ Useage is ' OLD ALIAS NEW See also SYNONYM for an immediate version ! : ALIAS ( xt -<name>- ) \ make another 'name' for 'xt' HEADER CFAPTR! ; ! : SYNONYM ( -<newname> <oldname>- ) ! \ *p Creates an alias of a word that will be immediate if the original word was \ ** immediate. The word order is the same as when making a colon definition. ! \ ** Bug: View <oldname> goes to the synonym instead. HEADER hide DEFINED DUP ?MISSING ! 1 = IF IMMEDIATE THEN \ make synonym immediate ! CFAPTR! reveal ; \ set the cfa pointer of header --- 4308,4331 ---- in-system ! : ALIAS ( xt -<name>- ) \ W32F ! \ *G Creates an alias of a word that is non-imediate (unless IMMEDIATE is used). ! \ *P NOTE View of either name can go to the synonym instead (it depends which name ! \ ** is found first in a full dictionary search). HEADER CFAPTR! ; ! : SYNONYM ( -<newname> <oldname>- ) \ 200X ! \ *G Creates an alias of a word that will be immediate if the original word was \ ** immediate. The word order is the same as when making a colon definition. ! \ ** <newname> is hidden during the search for <oldname> so that an alias of an ! \ ** existing word in another vocabulary can be created (NOTE versions prior to ! \ ** V6.10.05 and V6.11.10 incorrectly created a void definition when <newname> ! \ ** was found in the search. If <oldname> is not found then <newname> remains ! \ ** hidden (only since V6.10.05 and V6.11.10). ! \ *P NOTE View of either name can go to the synonym instead (it depends which name ! \ ** is found first in a full dictionary search). HEADER hide DEFINED DUP ?MISSING ! 1 = IF IMMEDIATE THEN \ make synonym immediate if original is ! CFAPTR! reveal ; \ set the cfa pointer of header |
|
From: George H. <geo...@us...> - 2006-08-24 11:44:10
|
Update of /cvsroot/win32forth/win32forth-610old/src/kernel In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv18140/win32forth-610old/src/kernel Modified Files: fkernel.f Log Message: gah:Modified SYNONYM to hide word until old word is found or on error Index: fkernel.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-610old/src/kernel/fkernel.f,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** fkernel.f 25 Feb 2006 08:38:05 -0000 1.6 --- fkernel.f 24 Aug 2006 11:44:07 -0000 1.7 *************** *** 4279,4286 **** \ ** immediate. The word order is the same as when making a colon definition. \ ** Bug: View <oldname> goes to the synonym instead. ! HEADER DEFINED DUP ?MISSING 1 = IF IMMEDIATE THEN \ make synonym immediate ! CFAPTR! ; \ set the cfa pointer of header --- 4279,4286 ---- \ ** immediate. The word order is the same as when making a colon definition. \ ** Bug: View <oldname> goes to the synonym instead. ! HEADER hide DEFINED DUP ?MISSING 1 = IF IMMEDIATE THEN \ make synonym immediate ! CFAPTR! reveal ; \ set the cfa pointer of header |
|
From: George H. <geo...@us...> - 2006-08-24 11:35:13
|
Update of /cvsroot/win32forth/win32forth/src/kernel In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv14314/win32forth/src/kernel Modified Files: fkernel.f Log Message: gah:Modified SYNONYM to hide word until old word is found or on error Index: fkernel.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/kernel/fkernel.f,v retrieving revision 1.34 retrieving revision 1.35 diff -C2 -d -r1.34 -r1.35 *** fkernel.f 13 Aug 2006 07:58:59 -0000 1.34 --- fkernel.f 24 Aug 2006 11:35:09 -0000 1.35 *************** *** 4314,4321 **** \ ** immediate. The word order is the same as when making a colon definition. \ ** Bug: View <oldname> goes to the synonym instead. ! HEADER DEFINED DUP ?MISSING 1 = IF IMMEDIATE THEN \ make synonym immediate ! CFAPTR! ; \ set the cfa pointer of header --- 4314,4321 ---- \ ** immediate. The word order is the same as when making a colon definition. \ ** Bug: View <oldname> goes to the synonym instead. ! HEADER hide DEFINED DUP ?MISSING 1 = IF IMMEDIATE THEN \ make synonym immediate ! CFAPTR! reveal ; \ set the cfa pointer of header |
|
From: George H. <geo...@us...> - 2006-08-24 10:14:35
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv4320/win32forth/src Modified Files: Utils.f Log Message: gah:More thread safety and documenting Index: Utils.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Utils.f,v retrieving revision 1.10 retrieving revision 1.11 diff -C2 -d -r1.10 -r1.11 *** Utils.f 29 Aug 2005 15:56:27 -0000 1.10 --- Utils.f 24 Aug 2006 10:14:30 -0000 1.11 *************** *** 42,47 **** \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ - IN-SYSTEM - : .cur-file ( -- ) ." The current file is: " cur-file count type ; --- 42,45 ---- *************** *** 53,58 **** \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ - in-system - : .platform ( -- ) cr ." Platform: Windows " --- 51,54 ---- *************** *** 75,79 **** : .loaded ( -- ) ! also files screendelay 0 to screendelay false to with-tabs? --- 71,75 ---- : .loaded ( -- ) ! also files screendelay 0 to screendelay false to with-tabs? *************** *** 292,295 **** --- 288,292 ---- defer win-abort ' abort is win-abort + : ?win-error ( f1 -- ) \ f1=0=failed \ ?win-error can only be used right after a CALL. It looks at the CALL word, \ finds the PROC and extracts the name of the function. It's a pretty nasty *************** *** 302,307 **** \ cells is the CALL). This is the pointer to the CALL CFA in the PROC; then \ it fetches the PROC address and displays the name. Horrible. - - : ?win-error ( f1 -- ) \ f1=0=failed 0= ?win-error-enabled and if \ build string for error message debugging --- 299,302 ---- *************** *** 522,539 **** IN-APPLICATION ! create TIME-BUF ! here nostack1 ! 0 w, \ +0 year ! 0 w, \ +2 month ! 0 w, \ +4 day of week ! 0 w, \ +6 day of month ! 0 w, \ +8 hour ! 0 w, \ +10 minute ! 0 w, \ +12 second ! 0 w, \ +14 milliseconds ! here swap - constant TIME-LEN ! create date$ 32 allot ! create time$ 32 allot : get-local-time ( -- ) \ get the local computer date and time --- 517,536 ---- IN-APPLICATION ! 16 constant TIME-LEN ! next-user dup @ aligned swap ! ! ! time-len newuser TIME-BUF ! \ +0 year ! \ +2 month ! \ +4 day of week ! \ +6 day of month ! \ +8 hour ! \ +10 minute ! \ +12 second ! \ +14 milliseconds ! ! 32 newuser date$ ! 32 newuser time$ : get-local-time ( -- ) \ get the local computer date and time *************** *** 542,546 **** create compile-version time-len allot \ a place to save the compile time ! get-local-time \ save as part o compiled image time-buf compile-version time-len move \ move time into buffer --- 539,543 ---- create compile-version time-len allot \ a place to save the compile time ! get-local-time \ save as part of compiled image time-buf compile-version time-len move \ move time into buffer *************** *** 647,651 **** 9323846 value SEED3 ! : RANDOM ( n1 -- n2 ) \ get a pseudo random number between 0 and n1 as n2 dup 0= if 1+ then SEED1 177 /MOD 2* SWAP 171 * SWAP - DUP to SEED1 --- 644,649 ---- 9323846 value SEED3 ! : RANDOM ( n1 -- n2 ) \ W32F Utils ! \ *G Get a pseudo random number between 0 and n1 as n2. n2 has the same sign as n1. dup 0= if 1+ then SEED1 177 /MOD 2* SWAP 171 * SWAP - DUP to SEED1 *************** *** 654,658 **** + + SWAP MOD ; ! : RANDOM-INIT ( -- ) \ initialize the random number generator get-local-time time-buf 3 cells + @ to SEED1 --- 652,658 ---- + + SWAP MOD ; ! : RANDOM-INIT ( -- ) \ W32F Utils ! \ *G Initialize the random number generator from the system clock. This is performed at ! \ ** program initialisation. get-local-time time-buf 3 cells + @ to SEED1 *************** *** 669,673 **** \ old Win32s support removed \ September 17th, 2003 - 10:38 dbu ! : _MS ( n1 -- ) \ delay n1 milli-seconds Call Sleep drop ; --- 669,673 ---- \ old Win32s support removed \ September 17th, 2003 - 10:38 dbu ! : _MS ( u -- ) \ delay u milli-seconds or forever if u=-1. Call Sleep drop ; *************** *** 727,734 **** locHdl close-file 3drop ; ! : ftype ( -<filename>- ) /parse-s$ count "ftype ; synonym flist ftype --- 727,738 ---- locHdl close-file 3drop ; ! : ftype ( -<filename>- ) \ W32F System Utils ! \ *G Type the contents of file -<filename>- at the console. If no extension is supplied ! \ ** then the default extension (.f) is applied. Relative paths are relative to the Forth ! \ ** search path. /parse-s$ count "ftype ; synonym flist ftype + \ *G Alternate name. *************** *** 800,804 **** MODULE - --- 804,808 ---- MODULE + \ *Z |
|
From: George H. <geo...@us...> - 2006-08-21 15:02:28
|
Update of /cvsroot/win32forth/win32forth/src/lib In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv7247/win32forth/src/lib Modified Files: ADO.f Log Message: gah:Modified EOF: and BOF: to use sw@ since (at least on W98) they are 16-bit values Index: ADO.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/ADO.f,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** ADO.f 19 Aug 2006 02:46:50 -0000 1.2 --- ADO.f 21 Aug 2006 15:02:23 -0000 1.3 *************** *** 329,337 **** :M EOF: ( -- flag ) \ *G Flag that indicates if the current record position is after the last record. ! xtra rec COM _Recordset GetEOF drop xtra @ ;M :M BOF: ( -- flag ) \ *G Flag that indicates if the current record position is before the first record. ! xtra rec COM _Recordset GetBOF drop xtra @ ;M :M FieldCnt: ( -- n ) --- 329,337 ---- :M EOF: ( -- flag ) \ *G Flag that indicates if the current record position is after the last record. ! xtra rec COM _Recordset GetEOF drop xtra sw@ ;M :M BOF: ( -- flag ) \ *G Flag that indicates if the current record position is before the first record. ! xtra rec COM _Recordset GetBOF drop xtra sw@ ;M :M FieldCnt: ( -- n ) |
|
From: George H. <geo...@us...> - 2006-08-21 15:00:46
|
Update of /cvsroot/win32forth/win32forth/demos/ADO In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv6058/win32forth/demos/ADO Modified Files: EX_Connstr.f Log Message: gah:Modified to use prepend<home>\\ to locate directory Index: EX_Connstr.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/demos/ADO/EX_Connstr.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** EX_Connstr.f 19 Aug 2006 02:37:16 -0000 1.1 --- EX_Connstr.f 21 Aug 2006 15:00:26 -0000 1.2 *************** *** 17,21 **** \ this may need to be changed to where ever the test database is. ! s" DBQ=C:\Program Files\Win32forth\demos\ADO\test.mdb" connstr +place --- 17,22 ---- \ this may need to be changed to where ever the test database is. ! s" DBQ=" connstr +place ! s" demos\ADO\test.mdb" prepend<home>\ connstr +place |
|
From: George H. <geo...@us...> - 2006-08-19 14:46:26
|
Update of /cvsroot/win32forth/win32forth/doc/classes In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv25602/win32forth/doc/classes Added Files: ADO.htm Log Message: gah:Added Tom Dixon's docs and updated indexes --- NEW FILE: ADO.htm --- <html> <head> <meta http-equiv="Content-Language" content="en-gb"> <meta name="GENERATOR" content="dexh00"> <meta name="ProgId" content="FrontPage.Editor.Document"> <meta http-equiv="Content-Type" content="text/html; charset=windows-1252"> <title> </title><style><!-- h1 { font-family: Tahoma; font-size: 24pt; font-weight: bold } h2 { font-family: Tahoma; font-size: 18pt; font-weight: bold } --> </style> </head> <body><h1 align="center"> <a href="mailto:win...@ya...?subject=DOC:Doc error in $Id: ADO.htm,v 1.1 2006/08/19 14:45:36 georgeahubert Exp $"> <img border="0" src="../TELLUS.gif" align="left" width="32" height="32"></a> <img border="0" src="../FORTHPRO.gif" width="32" height="32"> Win32Forth</h1> <hr /><h1>ADO -- ADO Classes for Database Interfacing </h1><hr /><h3><i>Tom Dixon - August 2006 </i></h3><p>These classes were developed to make accessing databases easy and convienent with win32forth. </p><h2> ADOConnection Class </h2><pre><b><a name="0">:class ADOConnection <SUPER Object </a></b></pre><p>An ADO connection object controls the access of cursors to the database. It is meant to control things such as tranactions, read/write properties and error handling. </p><pre><b><a name="1">:M Start: ( -- ) </a></b></pre><p>Initializes the ADO Connection Component. Most methods will not execute properly if this is not called when the object instance is created </p><pre><b><a name="2">:M Connect: ( -- ) </a></b></pre><p>Connects to the data source specified by the connection string with the given connection properties. </p><pre><b><a name="3">:M Close: ( -- flag ) </a></b></pre><p>Closes the database connection. The COM component still exists and a new connection may be made if desired. </p><pre><b><a name="4">:M GetErrorCnt: ( -- cnt ) </a></b></pre><p>Return the number of errors in the FIFO error queue </p><pre><b><a name="5">:M GetError: ( cnt -- n ) </a></b></pre><p>Return the error number of the 'cnt' error in the error queue </p><pre><b><a name="6">:M Error>str: ( n -- str len ) </a></b></pre><p>Return the error string of the 'cnt' error in the error queue </p><pre><b><a name="7">:M ClearErrors: ( -- ) </a></b></pre><p>Clears the FIFO error queue </p><pre><b><a name="8">:M ERR: ( n -- ) \ thows an error on any problem </a></b></pre><p>Displays and clears all errors in the queue </p><pre><b><a name="9">:M Transaction: ( -- ) </a></b></pre><p>Starts a transaction session for this connection. All changes performed on the database will not take effect until they are committed. Some databases may not support this functionality. </p><pre><b><a name="10">:M Commit: ( -- ) </a></b></pre><p>Commit all changes in the current transaction to the database. </p><pre><b><a name="11">:M RollBack: ( -- ) </a></b></pre><p>Drop all changes in the current transaction - no changes are made for the transaction session. </p><pre><b><a name="12">:M GetTimeOut: ( -- n ) </a></b></pre><p>Returns the timeout time (in seconds) that queries will give up. </p><pre><b><a name="13">:M SetTimeOut: ( n -- ) </a></b></pre><p>Sets the timeout time (in seconds) that queries will give up. </p><pre><b><a name="14">:M GetConnString: ( -- str len ) </a></b></pre><p>Return the connection string for the data source. This may not necessarily be the same string that was given to the object </p><pre><b><a name="15">:M SetConnString: ( str len -- ) </a></b></pre><p>Set the connection string for the data source. The connection string tells the object what drivers to use, where the database is, user name, and password. </p><pre><b><a name="16">:M GetProvider: ( -- str len ) </a></b></pre><p>Returns the provider for the connection. </p><pre><b><a name="17">:M SetProvider: ( str len -- ) </a></b></pre><p>Sets the provider for the connection. Can be set through the connection string as well. </p><pre><b><a name="18">:M GetMode: ( -- n ) </a></b></pre><p>Returns the connection mode. </p><pre><b><a name="19">:M SetMode: ( n -- ) </a></b></pre><p>Sets the connection mode. The connection mode indicates whether the database is read-only, write-only, sharable, etc...<br /> See the ConnectModeEnum constants below the class descriptions. </p><pre><b><a name="20">:M GetState: ( -- n ) </a></b></pre><p>Returns the current state of the connection object. </p><h2> ADOCursor Class </h2><pre><b><a name="21">:class ADOCursor <SUPER Object </a></b></pre><p>An ADO cursor object represents a recordset of data, or data in a table-like structure. Data can be loaded, updated, inserted through this object. </p><pre><b><a name="22">:M Start: ( -- ) </a></b></pre><p>Initializes the ADO Recordset Component. Most methods will not execute properly if this is not called when the object instance is created </p><pre><b><a name="23">:M SetConnection: ( ADOConnection -- ) </a></b></pre><p>Sets the connection object for this cursor. It is required before any query is executed. </p><pre><b><a name="24">:M GetCacheSize: ( -- n ) </a></b></pre><p>Returns the cache size of the cursor. The value is the number of records in the cache before updates are required. </p><pre><b><a name="25">:M SetCacheSize: ( n -- ) </a></b></pre><p>Sets the cache size of the cursor. The default is 1, or updates occur with every new record edited. </p><pre><b><a name="26">:M GetCursorType: ( -- ctype ) </a></b></pre><p>Returns the cursor type. </p><pre><b><a name="27">:M SetCursorType: ( ctype -- ) </a></b></pre><p>Sets the cursor type. The cursor type determines what is allowed on the cursor data and how data is seen in a multi-client environment. The possible values are: </p><table border="1"><tr><td>adOpenUnspecified </td> <td>The cursor type is unspecified. Usually defaults to adOpenForwardOnly </td> </tr> <tr><td>adOpenStatic </td> <td>All movement methods are available. Changes from other users are not visible </td> </tr> <tr><td>adOpenForwardOnly </td> <td>The cursor can only move forward. The record count and other navigation methods are invalid. This should have the best performance of the cursors. </td> </tr> <tr><td>adOpenDynamic </td> <td>All additions, deletions and changes from other users are visible </td> </tr> <tr><td>adOpenKeyset </td> <td>Like a dynamic cursor, except added records can't be seen and deleted records are inaccessible </td> </tr> </table><pre><b><a name="28">:M GetLockType: ( -- n ) </a></b></pre><p>Returns the lock type. </p><pre><b><a name="29">:M SetLockType: ( n -- ) </a></b></pre><p>Sets the lock type. The lock type determines how the database is to handle changes to the data on a cursor. The possible values are: </p><table border="1"><tr><td>adLockUnspecified </td> <td>The lock type is unspecified. Usually defaults to adLockReadOnly </td> </tr> <tr><td>adLockReadOnly </td> <td>The records are read-only. Data cannot be altered </td> </tr> <tr><td>adLockPessimistic </td> <td>Pessamistic locking. Record(s) are locked at the data source immediately when the alterations begin. </td> </tr> <tr><td>adLockOptimistic </td> <td>Optimistic locking. Record(s) are locked only when the update method is called </td> </tr> <tr><td>adLockBatchOptimistic </td> <td>Useful for batch updates. </td> </tr> </table><pre><b><a name="30">:M GetMaxRows: ( -- n ) </a></b></pre><p>Returns the maximum number of records to be returned in a query. </p><pre><b><a name="31">:M SetMaxRows: ( n -- ) </a></b></pre><p>Sets the maximum number of records to be returned from a query (0 = unlimited) </p><pre><b><a name="32">:M Close: ( -- ) </a></b></pre><p>Closes the cursor. Another query can be executed on the cursor once it has been closed. </p><pre><b><a name="33">:M GetState: ( -- n ) </a></b></pre><p>Returns the state of the cursor. Useful when executing queries asyncronously. </p><pre><b><a name="34">:M Executing?: ( -- flag ) </a></b></pre><p>Returns true if the query is still executing. </p><pre><b><a name="35">:M Fetching?: ( -- flag ) </a></b></pre><p>Returns true if the rows are still being retrieved </p><pre><b><a name="36">:M Execute: ( str len -- ) </a></b></pre><p>Execute a SQL query on the cursor. Any returned data will be in the cursor. </p><pre><b><a name="37">:M AsyncExecute: ( str len -- ) </a></b></pre><p>Operates the same as the execute method, but is asyncronous. The cursor's state will indicate if the query has finished executing or not. </p><pre><b><a name="38">:M Requery: ( n -- ) </a></b></pre><p>Rerun the last query. </p><pre><b><a name="39">:M RecordCount: ( -- n ) </a></b></pre><p>Return the number of records in cursor. May not work with the adOpenForwardOnly cursor type. </p><pre><b><a name="40">:M Move: ( n -- ) </a></b></pre><p>Move to the record number 'n' of the cursor's data </p><pre><b><a name="41">:M MoveFirst: ( -- ) </a></b></pre><p>Move to the first record of the cursor's data. </p><pre><b><a name="42">:M MoveNext: ( -- ) </a></b></pre><p>Move to the next record of the cursor's data </p><pre><b><a name="43">:M MovePrevious: ( -- ) </a></b></pre><p>Move to the previous record of the cursor's data </p><pre><b><a name="44">:M MoveLast: ( -- ) </a></b></pre><p>Move to the last record of the cursor's data </p><pre><b><a name="45">:M EOF: ( -- flag ) </a></b></pre><p>Flag that indicates if the current record position is after the last record. </p><pre><b><a name="46">:M BOF: ( -- flag ) </a></b></pre><p>Flag that indicates if the current record position is before the first record. </p><pre><b><a name="47">:M FieldCnt: ( -- n ) </a></b></pre><p>Returns the number of columns in the current record. </p><pre><b><a name="48">:M FieldType: ( field -- DataTypeEnum ) </a></b></pre><p>Returns the data type constant of the given column. Possible data types are: </p><table border="1"><tr><td>adEmpty </td> </tr> <tr><td>adTinyInt </td> </tr> <tr><td>adSmallInt </td> </tr> <tr><td>adInteger </td> </tr> <tr><td>adBigInt </td> </tr> <tr><td>adUnsignedTinyInt </td> </tr> <tr><td>adUnsignedSmallInt </td> </tr> <tr><td>adUnsignedInt </td> </tr> <tr><td>adUnsignedBigInt </td> </tr> <tr><td>adSingle </td> </tr> <tr><td>adDouble </td> </tr> <tr><td>adCurrency </td> </tr> <tr><td>adDecimal </td> </tr> <tr><td>adNumeric </td> </tr> <tr><td>adBoolean </td> </tr> <tr><td>adError </td> </tr> <tr><td>adUserDefined </td> </tr> <tr><td>adVariant </td> </tr> <tr><td>adIDispatch </td> </tr> <tr><td>adIUnknown </td> </tr> <tr><td>adGUID </td> </tr> <tr><td>adDate </td> </tr> <tr><td>adDBDate </td> </tr> <tr><td>adDBTime </td> </tr> <tr><td>adDBTimeStamp </td> </tr> <tr><td>adBSTR </td> </tr> <tr><td>adChar </td> </tr> <tr><td>adVarChar </td> </tr> <tr><td>adLongVarChar </td> </tr> <tr><td>adWChar </td> </tr> <tr><td>adVarWChar </td> </tr> <tr><td>adLongVarWChar </td> </tr> <tr><td>adBinary </td> </tr> <tr><td>adVarBinary </td> </tr> <tr><td>adLongVarBinary </td> </tr> <tr><td>adChapter </td> </tr> <tr><td>adFileTime </td> </tr> <tr><td>adPropVariant </td> </tr> <tr><td>adVarNumeric </td> </tr> <tr><td>adArray </td> </tr> </table><pre><b><a name="49">:M FieldName: ( field -- str len ) </a></b></pre><p>Returns the column name of the given column number. </p><pre><b><a name="50">:M FieldSize: ( field -- n ) </a></b></pre><p>Returns the data size of the given column number. </p><pre><b><a name="51">:M GetInt: ( field -- int ) </a></b></pre><p>Returns an integer value of the given column on the current row. </p><pre><b><a name="52">:M GetDouble: ( field -- d ) </a></b></pre><p>Returns the double of the given column on the current row. </p><pre><b><a name="53">:M GetFloat: ( field -- float ) </a></b></pre><p>Returns the floating point value of the given column on the current row. </p><pre><b><a name="54">:M GetStr: ( field -- str len ) </a></b></pre><p>Returns the string of the given column on the current row. May be much longer than 255 </p><pre><b><a name="55">:M GetTimeStamp: ( field -- float ) </a></b></pre><p>Return the timestamp value of the given column on the current row. The timestamp value is a floating point number that indicates the number of days since Dec 31, 1899. </p><pre><b><a name="56">:M GetDateTime: ( field -- sec min hour day month year ) </a></b></pre><p>Returns the datetime values of the given column on the current row. </p><pre><b><a name="57">:M isNull?: ( field -- flag ) </a></b></pre><p>Returns true if the given field for the given flag is null </p><pre><b><a name="58">:M SetInt: ( int field -- ) </a></b></pre><p>Sets the integer value of a given column on the current row. </p><pre><b><a name="59">:M SetDouble: ( d field -- ) </a></b></pre><p>Sets the double value of a given column on the current row. </p><pre><b><a name="60">:M SetFloat: ( float field -- ) </a></b></pre><p>Sets the floating point number of a given column on the current row. </p><pre><b><a name="61">:M SetNull: ( field -- ) </a></b></pre><p>Sets the field value to null of a given column on the current row. </p><pre><b><a name="62">:M SetStr: ( str len field -- ) </a></b></pre><p>Sets the string value of a given column on the current row. </p><pre><b><a name="63">:M SetTimeStamp: ( float field -- ) </a></b></pre><p>Sets the timestamp value of the given column on the current row. The timestamp value is a floating point number that indicates the number of days since Dec 31, 1899. </p><pre><b><a name="64">:M SetDateTime: ( sec min hour day month year field -- ) </a></b></pre><p>Sets the datetime values of the given column on the current row. </p><pre><b><a name="65">:M AddRow: ( -- ) </a></b></pre><p>Adds a new record to the end of the recordset and sets this as the current row. The row is not actually created until the update method is called. </p><pre><b><a name="66">:M DeleteRow: ( -- ) </a></b></pre><p>Deletes the current record. </p><pre><b><a name="67">:M Update: ( -- ) </a></b></pre><p>Updates the alterations to the data. </p><pre><b><a name="68">:M SaveNative: ( str len -- ) </a></b></pre><p>Saves the cursor's data to a file that is in a unspecified format. </p><pre><b><a name="69">:M SaveXML: ( str len -- ) </a></b></pre><p>Saves the cursor's data as a XML file. </p><pre><b><a name="70">:M SaveADTG: ( str len -- ) </a></b></pre><p>Saves the cursor's data in the Microsoft Advanced Data TableGram (ADTG) format. Requires a filename. </p><pre><b><a name="71">:M SaveCSV: ( str len -- ) </a></b></pre><p>Saves the cursor's data to a comma separated value file for easy viewing. Cannot be loaded later through the loadfile method. </p><pre><b><a name="72">:M LoadFile: ( str len -- ) </a></b></pre><p>Loads a cursor data file that was saved previously.<br /> A connection object is not required to load this data. </p><hr><p>Document $Id: ADO.htm,v 1.1 2006/08/19 14:45:36 georgeahubert Exp $</p> </body></html> |
|
From: George H. <geo...@us...> - 2006-08-19 14:45:41
|
Update of /cvsroot/win32forth/win32forth/doc In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv25602/win32forth/doc Modified Files: p-classes.htm p-index.htm w32f-glossary.csv Added Files: Unicode.htm Log Message: gah:Added Tom Dixon's docs and updated indexes Index: w32f-glossary.csv =================================================================== RCS file: /cvsroot/win32forth/win32forth/doc/w32f-glossary.csv,v retrieving revision 1.11 retrieving revision 1.12 diff -C2 -d -r1.11 -r1.12 *** w32f-glossary.csv 5 Jun 2006 09:28:42 -0000 1.11 --- w32f-glossary.csv 19 Aug 2006 14:45:36 -0000 1.12 *************** *** 1072,1073 **** --- 1072,1160 ---- "WM_WIN32FOR-INIT","--","w32f internal","COLON","","p-callback.htm#7" "HandleWindowsMessages","hwnd msg wParam lParam -- flag","","COLON","","p-callback.htm#9" + "UniPlace","addr len destaddr --","","COLON","","Unicode.htm#0" + "+UniPlace","addr len destaddr --","","COLON","","Unicode.htm#1" + "UniCount","addr -- addr len","","COLON","","Unicode.htm#2" + "ZUniCount","addr -- addr len","","COLON","","Unicode.htm#3" + "UniType","addr len --","","COLON","","Unicode.htm#4" + "Ustr,","addr n --","","COLON","","Unicode.htm#5" + "Asc>Uni","str len -- str len","!!! MUST FREE STRING AFTER !!!","COLON","","Unicode.htm#6" + "Uni>Asc","str len -- str len","!!! MUST FREE STRING AFTER !!!","COLON","","Unicode.htm#7" + ">Unicode","str len -- str len","","COLON","","Unicode.htm#8" + ">ascii","str len -- str len","","COLON","","Unicode.htm#9" + "U""","... "" -- str len","","COLON","","Unicode.htm#10" + "Asc>bstr","str len -- bstr","","COLON","","Unicode.htm#11" + "bstrFree","bstr --","","COLON","","Unicode.htm#12" + "bstrlen","ustr -- len","","COLON","","Unicode.htm#13" + "ADOConnection","","","CLASS","","ADO.htm#0" + "Start:","--","","METHOD","ADOConnection","ADO.htm#1" + "Connect:","--","","METHOD","ADOConnection","ADO.htm#2" + "Close:","-- flag","","METHOD","ADOConnection","ADO.htm#3" + "GetErrorCnt:","-- cnt","","METHOD","ADOConnection","ADO.htm#4" + "GetError:","cnt -- n","","METHOD","ADOConnection","ADO.htm#5" + "Error>str:","n -- str len","","METHOD","ADOConnection","ADO.htm#6" + "ClearErrors:","--","","METHOD","ADOConnection","ADO.htm#7" + "ERR:","n --","thows an error on any problem","METHOD","ADOConnection","ADO.htm#8" + "Transaction:","--","","METHOD","ADOConnection","ADO.htm#9" + "Commit:","--","","METHOD","ADOConnection","ADO.htm#10" + "RollBack:","--","","METHOD","ADOConnection","ADO.htm#11" + "GetTimeOut:","-- n","","METHOD","ADOConnection","ADO.htm#12" + "SetTimeOut:","n --","","METHOD","ADOConnection","ADO.htm#13" + "GetConnString:","-- str len","","METHOD","ADOConnection","ADO.htm#14" + "SetConnString:","str len --","","METHOD","ADOConnection","ADO.htm#15" + "GetProvider:","-- str len","","METHOD","ADOConnection","ADO.htm#16" + "SetProvider:","str len --","","METHOD","ADOConnection","ADO.htm#17" + "GetMode:","-- n","","METHOD","ADOConnection","ADO.htm#18" + "SetMode:","n --","","METHOD","ADOConnection","ADO.htm#19" + "GetState:","-- n","","METHOD","ADOConnection","ADO.htm#20" + "ADOCursor","","","CLASS","","ADO.htm#21" + "Start:","--","","METHOD","ADOCursor","ADO.htm#22" + "SetConnection:","ADOConnection --","","METHOD","ADOCursor","ADO.htm#23" + "GetCacheSize:","-- n","","METHOD","ADOCursor","ADO.htm#24" + "SetCacheSize:","n --","","METHOD","ADOCursor","ADO.htm#25" + "GetCursorType:","-- ctype","","METHOD","ADOCursor","ADO.htm#26" + "SetCursorType:","ctype --","","METHOD","ADOCursor","ADO.htm#27" + "GetLockType:","-- n","","METHOD","ADOCursor","ADO.htm#28" + "SetLockType:","n --","","METHOD","ADOCursor","ADO.htm#29" + "GetMaxRows:","-- n","","METHOD","ADOCursor","ADO.htm#30" + "SetMaxRows:","n --","","METHOD","ADOCursor","ADO.htm#31" + "Close:","--","","METHOD","ADOCursor","ADO.htm#32" + "GetState:","-- n","","METHOD","ADOCursor","ADO.htm#33" + "Executing?:","-- flag","","METHOD","ADOCursor","ADO.htm#34" + "Fetching?:","-- flag","","METHOD","ADOCursor","ADO.htm#35" + "Execute:","str len --","","METHOD","ADOCursor","ADO.htm#36" + "AsyncExecute:","str len --","","METHOD","ADOCursor","ADO.htm#37" + "Requery:","n --","","METHOD","ADOCursor","ADO.htm#38" + "RecordCount:","-- n","","METHOD","ADOCursor","ADO.htm#39" + "Move:","n --","","METHOD","ADOCursor","ADO.htm#40" + "MoveFirst:","--","","METHOD","ADOCursor","ADO.htm#41" + "MoveNext:","--","","METHOD","ADOCursor","ADO.htm#42" + "MovePrevious:","--","","METHOD","ADOCursor","ADO.htm#43" + "MoveLast:","--","","METHOD","ADOCursor","ADO.htm#44" + "EOF:","-- flag","","METHOD","ADOCursor","ADO.htm#45" + "BOF:","-- flag","","METHOD","ADOCursor","ADO.htm#46" + "FieldCnt:","-- n","","METHOD","ADOCursor","ADO.htm#47" + "FieldType:","field -- DataTypeEnum","","METHOD","ADOCursor","ADO.htm#48" + "FieldName:","field -- str len","","METHOD","ADOCursor","ADO.htm#49" + "FieldSize:","field -- n","","METHOD","ADOCursor","ADO.htm#50" + "GetInt:","field -- int","","METHOD","ADOCursor","ADO.htm#51" + "GetDouble:","field -- d","","METHOD","ADOCursor","ADO.htm#52" + "GetFloat:","field -- float","","METHOD","ADOCursor","ADO.htm#53" + "GetStr:","field -- str len","","METHOD","ADOCursor","ADO.htm#54" + "GetTimeStamp:","field -- float","","METHOD","ADOCursor","ADO.htm#55" + "GetDateTime:","field -- sec min hour day month year","","METHOD","ADOCursor","ADO.htm#56" + "isNull?:","field -- flag","","METHOD","ADOCursor","ADO.htm#57" + "SetInt:","int field --","","METHOD","ADOCursor","ADO.htm#58" + "SetDouble:","d field --","","METHOD","ADOCursor","ADO.htm#59" + "SetFloat:","float field --","","METHOD","ADOCursor","ADO.htm#60" + "SetNull:","field --","","METHOD","ADOCursor","ADO.htm#61" + "SetStr:","str len field --","","METHOD","ADOCursor","ADO.htm#62" + "SetTimeStamp:","float field --","","METHOD","ADOCursor","ADO.htm#63" + "SetDateTime:","sec min hour day month year field --","","METHOD","ADOCursor","ADO.htm#64" + "AddRow:","--","","METHOD","ADOCursor","ADO.htm#65" + "DeleteRow:","--","","METHOD","ADOCursor","ADO.htm#66" + "Update:","--","","METHOD","ADOCursor","ADO.htm#67" + "SaveNative:","str len --","","METHOD","ADOCursor","ADO.htm#68" + "SaveXML:","str len --","","METHOD","ADOCursor","ADO.htm#69" + "SaveADTG:","str len --","","METHOD","ADOCursor","ADO.htm#70" + "SaveCSV:","str len --","","METHOD","ADOCursor","ADO.htm#71" + "LoadFile:","str len --","","METHOD","ADOCursor","ADO.htm#72" Index: p-index.htm =================================================================== RCS file: /cvsroot/win32forth/win32forth/doc/p-index.htm,v retrieving revision 1.14 retrieving revision 1.15 diff -C2 -d -r1.14 -r1.15 *** p-index.htm 17 Jul 2006 15:29:36 -0000 1.14 --- p-index.htm 19 Aug 2006 14:45:36 -0000 1.15 *************** *** 153,156 **** --- 153,157 ---- <li><a href="p-AcceleratorTables.htm">Accelerator tables</a></li> <li><a href="Paths.htm">Multiple search path support</a></li> + <li><a href="Unicode.htm">Unicode Strings (for use with FCOM)</a></li> <li><a href="p-relnotes.6.12.htm">Release Notes</a></li> </ul> --- NEW FILE: Unicode.htm --- <html> <head> <meta http-equiv="Content-Language" content="en-gb"> <meta name="GENERATOR" content="dexh00"> <meta name="ProgId" content="FrontPage.Editor.Document"> <meta http-equiv="Content-Type" content="text/html; charset=windows-1252"> <title> </title><style><!-- h1 { font-family: Tahoma; font-size: 24pt; font-weight: bold } h2 { font-family: Tahoma; font-size: 18pt; font-weight: bold } --> </style> </head> <body><h1 align="center"> <a href="mailto:win...@ya...?subject=DOC:Doc error in $Id: Unicode.htm,v 1.1 2006/08/19 14:45:36 georgeahubert Exp $"> <img border="0" src="TELLUS.gif" align="left" width="32" height="32"></a> <img border="0" src="FORTHPRO.gif" width="32" height="32"> Win32Forth</h1> <hr /><h1>Unicode Wordset </h1><hr /><h3><i>Tom Dixon - August 2006 </i></h3><p>Unicode wordset for working with Unicode APIs </p><pre><b><a name="0">: UniPlace ( addr len destaddr -- ) </a></b></pre><p>Store a unicode string to an address </p><pre><b><a name="1">: +UniPlace ( addr len destaddr -- ) </a></b></pre><p>Append a string to the end of an address </p><pre><b><a name="2">: UniCount ( addr -- addr len ) </a></b></pre><p>Fetch a unicode string from an address (stored with uniplace) </p><pre><b><a name="3">: ZUniCount ( addr -- addr len ) </a></b></pre><p>Fetch a null-terminated unicode string from an address (null is 16-bit) </p><pre><b><a name="4">: UniType ( addr len -- ) </a></b></pre><p>Type a unicode string to the console </p><pre><b><a name="5">: Ustr, ( addr n -- ) </a></b></pre><p>Store a unicode string to the dictionary at HERE </p><pre><b><a name="6">: Asc>Uni ( str len -- str len ) \ !!! MUST FREE STRING AFTER !!! </a></b></pre><p>Convert a ascii string to unicode.<br /> must free unicode string with 'free' when no longer needed. </p><pre><b><a name="7">: Uni>Asc ( str len -- str len ) \ !!! MUST FREE STRING AFTER !!! </a></b></pre><p>Convert a unicode string to ascii<br /> must free ascii string afterwards when no longer needed. </p><pre><b><a name="8">: >Unicode ( str len -- str len ) </a></b></pre><p>Convert ascii string to unicode (uses new$) </p><pre><b><a name="9">: >ascii ( str len -- str len ) </a></b></pre><p>Convert unicode string to ascii (uses new$) </p><pre><b><a name="10">: U" ( ... " -- str len ) </a></b></pre><p>Unicode string - same as s" </p><pre><b><a name="11">: Asc>bstr ( str len -- bstr ) </a></b></pre><p>Convert ascii string to unicode bstr. bstr must be freed later with 'bstrfree'. </p><pre><b><a name="12">: bstrFree ( bstr -- ) </a></b></pre><p>Free a bstr. </p><pre><b><a name="13">: bstrlen ( ustr -- len ) </a></b></pre><p>Returns the length of the bstr. From this the bstr can be used with all the other unicode functions. </p><hr><p>Document $Id: Unicode.htm,v 1.1 2006/08/19 14:45:36 georgeahubert Exp $</p> </body></html> Index: p-classes.htm =================================================================== RCS file: /cvsroot/win32forth/win32forth/doc/p-classes.htm,v retrieving revision 1.12 retrieving revision 1.13 diff -C2 -d -r1.12 -r1.13 *** p-classes.htm 28 May 2006 09:48:21 -0000 1.12 --- p-classes.htm 19 Aug 2006 14:45:36 -0000 1.13 *************** *** 154,157 **** --- 154,165 ---- <li><a href="./classes/File.htm#File">File</a> Class for file I/O.</li> <li><a href="./classes/File.htm#ReadFile">ReadFile</a> Class for loading/saving a complete file from/to memory.</li> + </ul> + + <h2>ADO Classes</h2> + <ul> + <li><a href="./classes/ADO.htm#0">ADOConnection</a> For connecting to a database.</li> + <li><a href="./classes/ADO.htm#21">ADOCursor</a> For manipulating recordsets.</li> + </ul> + <hr> |
|
From: Tom D. <phe...@us...> - 2006-08-19 02:46:54
|
Update of /cvsroot/win32forth/win32forth/src/lib In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv29624/src/lib Modified Files: ADO.f Log Message: changed typelibrary to ADO 2.5 Index: ADO.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/ADO.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** ADO.f 19 Aug 2006 02:37:17 -0000 1.1 --- ADO.f 19 Aug 2006 02:46:50 -0000 1.2 *************** *** 8,12 **** needs fcom ! 2 7 typelib {EF53050B-882E-4776-B643-EDA472E8E3F2} \ inlude ADO type library --- 8,12 ---- needs fcom ! 2 5 typelib {00000205-0000-0010-8000-00AA006D2EA4} \ inlude ADO type library |
|
From: Tom D. <phe...@us...> - 2006-08-19 02:37:21
|
Update of /cvsroot/win32forth/win32forth/demos/ADO In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv26025/demos/ADO Added Files: ADOreadme.txt EX_Connstr.f EX_Create.f EX_Dump.f EX_Ins.f EX_InsSQL.f Log Message: ADO classes and examples added. --- NEW FILE: EX_Create.f --- \ Example of Creating Database Tables \ Tom Dixon needs ADO needs EX_Connstr.f \ load in the connection string \ declare the objects that we are going to work with ADOConnection conn ADOCursor cursor start: conn \ start the connection connstr count setconnstring: conn \ set the connection string adModeReadWrite setmode: conn \ set the mode to read and write connect: conn \ connect to the database start: cursor \ start the cursor conn SetConnection: cursor \ tell cursor to use the 'conn' connection object adLockOptimistic SetLockType: cursor \ Lock on updates create qstr LMAXSTRING allot \ Create a generic Globals Table s" CREATE TABLE globals ( " qstr lplace s" global_name varchar(64) not null, " qstr +lplace s" global_char varchar(255) null, " qstr +lplace s" global_text text null, " qstr +lplace s" global_datetime datetime null, " qstr +lplace s" global_integer int null, " qstr +lplace s" global_float float null) " qstr +lplace qstr lcount execute: cursor close: cursor close: conn --- NEW FILE: ADOreadme.txt --- These files are examples on how to use the ADO classes. In order to run them, you must setup a database and make sure that the connection string in EX_Connstr.F points to it. An access database is the easiest to make. All the examples use EX_Connstr.f to connect. EX_Create.f - creates a table in the database EX_InsSQL.F - inserts records into the table (through SQL) EX_Ins.F - inserts records programmatically EX_Dump.F - dumps a column of the table If you run the examples in the order listed, there should be no errors. Drop the table from the database to run them again. --- NEW FILE: EX_Connstr.f --- \ Database Connection Example \ Tom Dixon \ ADO connects to a database through the connection string. \ This connection string can take several different formats. \ For our example, we will only use Access needs ADO defined connstr nip 0= [if] create connstr 256 allot [then] s" DRIVER={Microsoft Access Driver (*.mdb)};" connstr place \ this may need to be changed to where ever the test database is. s" DBQ=C:\Program Files\Win32forth\demos\ADO\test.mdb" connstr +place \ For a large list of other connection string options, as well as examples \ of other databases, look at \ http://www.carlprothman.net/Default.aspx?tabid=81 --- NEW FILE: EX_Ins.f --- \ Example of inserting data programmatically \ Tom Dixon \ This example shows how to insert data programmatically. needs ADO needs EX_Connstr.f \ load in the connection string \ declare the objects that we are going to work with ADOConnection conn ADOCursor cursor start: conn \ start the connection connstr count setconnstring: conn \ set the connection string adModeReadWrite setmode: conn \ set the mode to read and write connect: conn \ connect to the database start: cursor \ start the cursor conn SetConnection: cursor \ tell cursor to use the 'conn' connection object adLockOptimistic SetLockType: cursor \ Lock on updates \ retrieve the table s" SELECT * FROM globals" execute: cursor \ add a float global addrow: cursor \ add a row to the end s" PI" 0 setstr: cursor 3.14159265358979e0 5 setfloat: cursor update: cursor \ add an integer global addrow: cursor s" Major Version" 0 setstr: cursor 3 4 setint: cursor update: cursor \ add a date global addrow: cursor s" Testdate" 0 setstr: cursor time&date 3 setdatetime: cursor update: cursor \ add a varchar addrow: cursor s" Owner" 0 setstr: cursor s" Billy Bones" 2 setstr: cursor update: cursor \ clean up close: cursor close: conn --- NEW FILE: EX_Dump.f --- \ Example of Selecting and displaying Data \ Tom Dixon \ This example shows how to access data from a cursor needs ADO needs EX_Connstr.f \ load in the connection string \ declare the objects that we are going to work with ADOConnection conn ADOCursor cursor start: conn \ start the connection connstr count setconnstring: conn \ set the connection string connect: conn \ connect to the database start: cursor \ start the cursor conn SetConnection: cursor \ tell cursor to use the 'conn' connection object \ retrieve the table s" SELECT * FROM globals" execute: cursor : testdump ( -- ) cr movefirst: cursor 0 fieldname: cursor dup >r type cr r> 0 ?do [char] - emit loop cr begin 0 getstr: cursor type cr movenext: cursor eof: cursor until ; testdump \ clean up close: cursor close: conn --- NEW FILE: EX_InsSQL.f --- \ Example of inserting data into a database VIA SQL \ Tom Dixon \ This example shows how to execut SQL queries to insert \ data into a table needs ADO needs EX_Connstr.f \ load in the connection string \ declare the objects that we are going to work with ADOConnection conn ADOCursor cursor start: conn \ start the connection connstr count setconnstring: conn \ set the connection string adModeReadWrite setmode: conn \ set the mode to read and write connect: conn \ connect to the database start: cursor \ start the cursor conn SetConnection: cursor \ tell cursor to use the 'conn' connection object adLockOptimistic SetLockType: cursor \ Lock on updates create qstr LMAXSTRING allot s" INSERT INTO globals (global_name, global_text, global_integer, global_datetime)" qstr lplace s" VALUES('StartDate','The Date the database was started',1,now())" qstr +lplace qstr lcount execute: cursor close: cursor close: conn |
|
From: Tom D. <phe...@us...> - 2006-08-19 02:37:21
|
Update of /cvsroot/win32forth/win32forth/src/lib In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv26025/src/lib Added Files: ADO.f Log Message: ADO classes and examples added. --- NEW FILE: ADO.f --- \ *D doc\classes\ \ *! ADO \ *T ADO -- ADO Classes for Database Interfacing \ *Q Tom Dixon - August 2006 \ ** These classes were developed to make accessing databases easy and convienent \ ** with win32forth. needs fcom 2 7 typelib {EF53050B-882E-4776-B643-EDA472E8E3F2} \ inlude ADO type library create UComma 32 allot u" ," UComma uniplace \ Column Delimeter create Ucrlf 32 allot crlf$ count >unicode Ucrlf uniplace \ New Record Delimeter create Unull 32 allot u" " Unull uniplace \ Null Character Replacement \ *S ADOConnection Class :class ADOConnection <SUPER Object \ *G An ADO connection object controls the access of cursors to the database. \ ** It is meant to control things such as tranactions, read/write properties \ ** and error handling. CELL bytes Conn CELL bytes Errs 16 bytes xtra int mstr int mstrlen :M Freemstr: ( -- ) mstr if mstr free drop 0 to mstr 0 to mstrlen then ;M :M ~: ( -- ) Conn @ if Conn COM _Connection Release drop 0 Conn ! then Freemstr: self ;M :M Start: ( -- ) \ *G Initializes the ADO Connection Component. Most methods will not execute properly \ ** if this is not called when the object instance is created Conn @ 0= if Conn _Connection 1 0 Connection CoCreateInstance abort" Unable to Create Connection Object!" then ;M :M Connect: ( -- ) \ *G Connects to the data source specified by the connection string with the given \ ** connection properties. 0 0 0 0 Conn COM _Connection Open drop ;M :M GetConn: ( -- IConn ) Conn @ ;M :M Close: ( -- flag ) \ *G Closes the database connection. The COM component still exists and a new \ ** connection may be made if desired. Conn COM _Connection Close drop Freemstr: self ;M :M BSTR>ASC: ( bstr -- str len ) dup 0= if drop s" " exitm then Freemstr: self dup dup bstrlen ?dup if uni>asc else drop s" " then 2dup to mstrlen to mstr rot bstrfree ;M :M GetErrorCnt: ( -- cnt ) \ *G Return the number of errors in the FIFO error queue Errs Conn COM _Connection GetErrors abort" Unable to Get Errors!" xtra Errs COM Errors GetCount drop xtra @ Errs COM Errors Release drop ;M :M GetError: ( cnt -- n ) \ *G Return the error number of the 'cnt' error in the error queue Errs Conn COM _Connection GetErrors abort" Unable to Get Errors!" xtra 0 rot 0 VT_I4 Errs COM Errors GetItem abort" Unable to get Error!" 0 >r rp@ xtra COM Error GetNumber drop r> xtra COM Error Release drop Errs COM Errors Release drop ;M :M Error>str: ( n -- str len ) \ *G Return the error string of the 'cnt' error in the error queue Errs Conn COM _Connection GetErrors abort" Unable to Get Errors!" xtra 0 rot 0 VT_I4 Errs COM Errors GetItem abort" Unable to get Error!" 0 >r rp@ xtra COM Error GetDescription drop r> bstr>asc: self xtra COM Error Release drop Errs COM Errors Release drop ;M :M ClearErrors: ( -- ) \ *G Clears the FIFO error queue Errs Conn COM _Connection GetErrors abort" Unable to Get Errors!" Errs COM Errors Clear drop Errs COM Errors Release drop ;M :M ERR: ( n -- ) \ thows an error on any problem \ *G Displays and clears all errors in the queue GetErrorCnt: self 0 ?do i Error>str: self type cr loop clearerrors: self ;M :M Transaction: ( -- ) \ *G Starts a transaction session for this connection. All changes \ ** performed on the database will not take effect until they are committed. \ ** Some databases may not support this functionality. xtra Conn COM _Connection BeginTrans drop xtra @ drop \ nesting level - don't use right now... ;M :M Commit: ( -- ) \ *G Commit all changes in the current transaction to the database. Conn COM _Connection CommitTrans drop ;M :M RollBack: ( -- ) \ *G Drop all changes in the current transaction - no changes are made for the \ ** transaction session. Conn COM _Connection RollbackTrans drop ;M :M GetTimeOut: ( -- n ) \ *G Returns the timeout time (in seconds) that queries will give up. xtra Conn COM _Connection GetCommandTimeout drop xtra @ ;M :M SetTimeOut: ( n -- ) \ *G Sets the timeout time (in seconds) that queries will give up. Conn COM _Connection PutCommandTimeout drop ;M :M GetConnString: ( -- str len ) \ *G Return the connection string for the data source. This may not necessarily \ ** be the same string that was given to the object xtra Conn COM _Connection GetConnectionString drop xtra @ bstr>asc: self ;M :M SetConnString: ( str len -- ) \ *G Set the connection string for the data source. The connection string tells \ ** the object what drivers to use, where the database is, user name, and password. Asc>bstr dup >r Conn COM _Connection PutConnectionString abort" Unable to set Connection String!" r> bstrfree ;M :M GetProvider: ( -- str len ) \ *G Returns the provider for the connection. xtra Conn COM _Connection GetProvider drop xtra @ bstr>asc: self ;M :M SetProvider: ( str len -- ) \ *G Sets the provider for the connection. Can be set through the connection string \ ** as well. Asc>bstr drop dup >r Conn COM _Connection PutProvider abort" Unable to set Provider!" r> bstrfree ;M :M GetMode: ( -- n ) \ *G Returns the connection mode. xtra Conn COM _Connection GetMode drop xtra @ ;M :M SetMode: ( n -- ) \ *G Sets the connection mode. The connection mode indicates whether the database \ ** is read-only, write-only, sharable, etc...\n \ ** See the ConnectModeEnum constants below the class descriptions. Conn COM _Connection PutMode drop ;M :M GetState: ( -- n ) \ *G Returns the current state of the connection object. xtra Conn COM _Connection GetState drop xtra @ ;M ;class \ *S ADOCursor Class :class ADOCursor <SUPER Object \ *G An ADO cursor object represents a recordset of data, or data in a table-like \ ** structure. Data can be loaded, updated, inserted through this object. CELL bytes Rec CELL bytes flds CELL bytes fld 16 bytes xtra int CONNptr int mstr int mstrlen :M Freemstr: ( -- ) mstr if mstr free drop 0 to mstr 0 to mstrlen then ;M :M ~: ( -- ) Rec @ if Rec COM _Recordset Release drop 0 Rec ! then Freemstr: self ;M :M Start: ( -- ) \ *G Initializes the ADO Recordset Component. Most methods will not execute properly \ ** if this is not called when the object instance is created Rec @ 0= if Rec _Recordset 1 0 RecordSet CoCreateInstance abort" Unable to Create Recordset Object!" then ;M :M BSTR>ASC: ( bstr -- str len ) dup 0= if drop s" " exitm then Freemstr: self dup dup bstrlen ?dup if uni>asc else drop s" " then 2dup to mstrlen to mstr rot bstrfree ;M :M SetConnection: ( ADOConnection -- ) \ *G Sets the connection object for this cursor. It is required before any query \ ** is executed. to CONNptr ;M :M GetCacheSize: ( -- n ) \ *G Returns the cache size of the cursor. The value is the number of records in the \ ** cache before updates are required. xtra rec COM _Recordset GetCacheSize drop xtra @ ;M :M SetCacheSize: ( n -- ) \ *G Sets the cache size of the cursor. The default is 1, or updates occur with every \ ** new record edited. rec COM _Recordset PutCacheSize drop ;M :M GetCursorType: ( -- ctype ) \ *G Returns the cursor type. xtra rec COM _Recordset GetCursorType drop xtra @ ;M :M SetCursorType: ( ctype -- ) \ *G Sets the cursor type. The cursor type determines what is allowed on the cursor \ ** data and how data is seen in a multi-client environment. The possible values are: \ *L \ *| adOpenUnspecified | The cursor type is unspecified. Usually defaults to adOpenForwardOnly | \ *| adOpenStatic | All movement methods are available. Changes from other users are not visible | \ *| adOpenForwardOnly | The cursor can only move forward. The record count and other navigation methods are invalid. This should have the best performance of the cursors. | \ *| adOpenDynamic | All additions, deletions and changes from other users are visible | \ *| adOpenKeyset | Like a dynamic cursor, except added records can't be seen and deleted records are inaccessible | rec COM _Recordset PutCursorType drop ;M :M GetLockType: ( -- n ) \ *G Returns the lock type. xtra rec COM _Recordset GetLockType drop xtra @ ;M :M SetLockType: ( n -- ) \ *G Sets the lock type. The lock type determines how the database is to handle changes \ ** to the data on a cursor. The possible values are: \ *L \ *| adLockUnspecified | The lock type is unspecified. Usually defaults to adLockReadOnly | \ *| adLockReadOnly | The records are read-only. Data cannot be altered | \ *| adLockPessimistic | Pessamistic locking. Record(s) are locked at the data source immediately when the alterations begin. | \ *| adLockOptimistic | Optimistic locking. Record(s) are locked only when the update method is called | \ *| adLockBatchOptimistic | Useful for batch updates. | rec COM _Recordset PutLockType drop ;M :M GetMaxRows: ( -- n ) \ *G Returns the maximum number of records to be returned in a query. xtra rec COM _Recordset GetMaxRecords drop xtra @ ;M :M SetMaxRows: ( n -- ) \ *G Sets the maximum number of records to be returned from a query (0 = unlimited) rec COM _Recordset PutMaxRecords drop ;M :M Close: ( -- ) \ *G Closes the cursor. Another query can be executed on the cursor once it has been closed. Rec COM _Recordset Close drop ;M :M GetState: ( -- n ) \ *G Returns the state of the cursor. Useful when executing queries asyncronously. xtra Rec COM _Recordset GetState drop xtra @ ;M :M Executing?: ( -- flag ) \ *G Returns true if the query is still executing. GetState: self adStateExecuting and ;M :M Fetching?: ( -- flag ) \ *G Returns true if the rows are still being retrieved GetState: self adStateFetching and ;M :M (Execute): ( str len option -- ) -rot asc>bstr >r GetLockType: self GetCursorType: self 0 CONNptr dup if GetConn: ADOConnection then 0 VT_DISPATCH 0 r@ 0 VT_BSTR Rec COM _RecordSet Open r> bstrfree if CONNptr dup if err: ADOConnection then true abort" Unable to Execute Query!" then ;M :M Execute: ( str len -- ) \ *G Execute a SQL query on the cursor. Any returned data will be in the cursor. adOptionUnspecified (Execute): self ;M :M AsyncExecute: ( str len -- ) \ *G Operates the same as the execute method, but is asyncronous. The cursor's \ ** state will indicate if the query has finished executing or not. adAsyncExecute (Execute): self ;M :M Requery: ( n -- ) \ *G Rerun the last query. rec COM _Recordset Requery drop ;M :M RecordCount: ( -- n ) \ *G Return the number of records in cursor. May not work with the adOpenForwardOnly \ ** cursor type. xtra rec COM _Recordset GetRecordCount drop xtra @ ;M :M Move: ( n -- ) \ *G Move to the record number 'n' of the cursor's data >r 0 DISP_E_PARAMNOTFOUND 0 VT_ERROR r> rec COM _Recordset Move drop ;M :M MoveFirst: ( -- ) \ *G Move to the first record of the cursor's data. rec COM _Recordset MoveFirst drop ;M :M MoveNext: ( -- ) \ *G Move to the next record of the cursor's data rec COM _Recordset MoveNext drop ;M :M MovePrevious: ( -- ) \ *G Move to the previous record of the cursor's data rec COM _Recordset MovePrevious drop ;M :M MoveLast: ( -- ) \ *G Move to the last record of the cursor's data rec COM _Recordset MoveLast drop ;M :M EOF: ( -- flag ) \ *G Flag that indicates if the current record position is after the last record. xtra rec COM _Recordset GetEOF drop xtra @ ;M :M BOF: ( -- flag ) \ *G Flag that indicates if the current record position is before the first record. xtra rec COM _Recordset GetBOF drop xtra @ ;M :M FieldCnt: ( -- n ) \ *G Returns the number of columns in the current record. flds rec COM _Recordset GetFields abort" Fields error!" xtra flds COM Fields GetCount drop xtra @ flds COM Fields Release drop ;M :M FieldType: ( field -- DataTypeEnum ) \ *G Returns the data type constant of the given column. Possible data types are: \ *L \ *| adEmpty | \ *| adTinyInt | \ *| adSmallInt | \ *| adInteger | \ *| adBigInt| \ *| adUnsignedTinyInt | \ *| adUnsignedSmallInt | \ *| adUnsignedInt | \ *| adUnsignedBigInt | \ *| adSingle | \ *| adDouble | \ *| adCurrency | \ *| adDecimal | \ *| adNumeric | \ *| adBoolean | \ *| adError | \ *| adUserDefined | \ *| adVariant | \ *| adIDispatch | \ *| adIUnknown | \ *| adGUID | \ *| adDate | \ *| adDBDate | \ *| adDBTime | \ *| adDBTimeStamp | \ *| adBSTR | \ *| adChar | \ *| adVarChar | \ *| adLongVarChar | \ *| adWChar | \ *| adVarWChar | \ *| adLongVarWChar | \ *| adBinary | \ *| adVarBinary | \ *| adLongVarBinary | \ *| adChapter | \ *| adFileTime | \ *| adPropVariant | \ *| adVarNumeric | \ *| adArray | flds rec COM _Recordset GetFields abort" Fields error!" fld 0 rot 0 VT_I4 flds COM Fields GetItem abort" Not a Field!" xtra fld COM Field GetType drop xtra @ flds COM Fields Release drop ;M :M FieldName: ( field -- str len ) \ *G Returns the column name of the given column number. flds rec COM _Recordset GetFields abort" Fields error!" fld 0 rot 0 VT_I4 flds COM Fields GetItem abort" Not a Field!" xtra fld COM Field GetName drop xtra @ bstr>asc: self fld COM Field Release drop flds COM Fields Release drop ;M :M FieldSize: ( field -- n ) \ *G Returns the data size of the given column number. flds rec COM _Recordset GetFields abort" Fields error!" fld 0 rot 0 VT_I4 flds COM Fields GetItem abort" Not a Field!" xtra fld COM Field GetActualSize drop xtra @ fld COM Field Release drop flds COM Fields Release drop ;M :M GetValue: ( field -- ) xtra 16 0 fill flds rec COM _Recordset GetFields abort" Fields error!" fld 0 rot 0 VT_I4 flds COM Fields GetItem abort" Not a Field!" xtra fld COM Field GetValue drop fld COM Field Release drop flds COM Fields Release drop ;M :M GetInt: ( field -- int ) \ *G Returns an integer value of the given column on the current row. GetValue: self xtra @ VT_NULL = if 0 else xtra 2 cells + @ then ;M :M GetDouble: ( field -- d ) \ *G Returns the double of the given column on the current row. GetValue: self xtra @ VT_NULL = if 0 0 else xtra 2 cells + 2@ then ;M :M GetFloat: ( field -- float ) \ *G Returns the floating point value of the given column on the current row. GetValue: self xtra @ VT_NULL = if 0e0 else xtra 8 + df@ then ;M :M GetStr: ( field -- str len ) \ *G Returns the string of the given column on the current row. May be much longer than 255 GetValue: self xtra @ VT_NULL = if s" " else xtra 2 cells + @ bstr>asc: self then ;M :M GetTimeStamp: ( field -- float ) \ *G Return the timestamp value of the given column on the current row. The timestamp value is \ ** a floating point number that indicates the number of days since Dec 31, 1899. GetFloat: self ;M :M GetDateTime: ( field -- sec min hour day month year ) \ *G Returns the datetime values of the given column on the current row. GetValue: self xtra @ VT_NULL = if 0 0 0 0 0 0 exitm then time-buf xtra 8 + 2@ call VariantTimeToSystemTime drop time-buf 12 + w@ \ seconds time-buf 10 + w@ \ minutes time-buf 8 + w@ \ hours time-buf 6 + w@ \ day of month time-buf 2 + w@ \ month of year time-buf w@ ;M \ year :M isNull?: ( field -- flag ) \ *G Returns true if the given field for the given flag is null getValue: self xtra @ VT_NULL = ;M :M SetValue: ( variant field -- ) \ puts xtra variant into Field flds rec COM _Recordset GetFields abort" Fields error!" fld 0 rot 0 VT_I4 flds COM Fields GetItem abort" Not a Field!" fld COM Field PutValue abort" Value Not Set!" fld COM Field Release drop flds COM Fields Release drop ;M :M SetInt: ( int field -- ) \ *G Sets the integer value of a given column on the current row. >r 0 swap 0 VT_I4 r> SetValue: self ;M :M SetDouble: ( d field -- ) \ *G Sets the double value of a given column on the current row. >r 0 VT_I8 r> SetValue: self ;M :M SetFloat: ( float field -- ) \ *G Sets the floating point number of a given column on the current row. >r fs>ds 0 VT_R8 r> SetValue: self ;M :M SetNull: ( field -- ) \ *G Sets the field value to null of a given column on the current row. >r 0 0 0 VT_NULL r> SetValue: self ;M :M SetStr: ( str len field -- ) \ *G Sets the string value of a given column on the current row. -rot asc>bstr dup >r swap >r 0 swap 0 VT_BSTR r> SetValue: self r> bstrfree ;M :M SetTimeStamp: ( float field -- ) \ *G Sets the timestamp value of the given column on the current row. The timestamp value is \ ** a floating point number that indicates the number of days since Dec 31, 1899. SetFloat: self ;M :M SetDateTime: ( sec min hour day month year field -- ) \ *G Sets the datetime values of the given column on the current row. time-buf time-len 0 fill >r time-buf w! \ year time-buf 2 + w! \ month time-buf 6 + w! \ day time-buf 8 + w! \ hours time-buf 10 + w! \ minutes time-buf 12 + w! \ seconds xtra time-buf call SystemTimeToVariantTime 0= abort" Unable to Convert DateTime!" xtra 4 + @ xtra @ 0 VT_DATE r> SetValue: self ;M :M AddRow: ( -- ) \ *G Adds a new record to the end of the recordset and sets this as the current row. The row \ ** is not actually created until the update method is called. 0 DISP_E_PARAMNOTFOUND 0 VT_ERROR 0 DISP_E_PARAMNOTFOUND 0 VT_ERROR rec COM _Recordset AddNew abort" Unable to Add Row!" ;M :M DeleteRow: ( -- ) \ *G Deletes the current record. adAffectCurrent rec COM _Recordset Delete abort" Unable to Delete Row!" ;M :M Update: ( -- ) \ *G Updates the alterations to the data. 0 DISP_E_PARAMNOTFOUND 0 VT_ERROR 0 DISP_E_PARAMNOTFOUND 0 VT_ERROR rec COM _Recordset Update abort" Update Failed!" ;M :M (Save): ( str len type -- ) -rot asc>bstr dup >r 0 swap 0 VT_BSTR Rec COM _RecordSet Save abort" Unable to Save!" r> bstrfree ;M :M SaveNative: ( str len -- ) \ *G Saves the cursor's data to a file that is in a unspecified format. 0 (Save): self ;M :M SaveXML: ( str len -- ) \ *G Saves the cursor's data as a XML file. adPersistXML (Save): self ;M :M SaveADTG: ( str len -- ) \ *G Saves the cursor's data in the Microsoft Advanced Data TableGram (ADTG) format. \ ** Requires a filename. adPersistADTG (Save): self ;M :M SaveCSV: ( str len -- ) \ *G Saves the cursor's data to a comma separated value file for easy viewing. \ ** Cannot be loaded later through the loadfile method. xtra 16 0 fill xtra UNull cell+ Ucrlf cell+ Ucomma cell+ -1 adClipString Rec COM _Recordset GetString abort" Unable to Convert Records!" w/o create-file abort" Unable to Create File!" >r xtra @ bstr>asc: self r@ write-file drop r> close-file drop ;M :M LoadFile: ( str len -- ) \ *G Loads a cursor data file that was saved previously.\n \ ** A connection object is not required to load this data. adCmdFile (Execute): self ;M ;class \ Relavant ADO Constants \ This may seem unnecessary, but once we unload the type library, the \ constants will not be accessible, so they are redefined as forth \ constants \ ConnectModeEnum adModeUnknown CONSTANT adModeUnknown adModeRead CONSTANT adModeRead adModeWrite CONSTANT adModeWrite adModeReadWrite CONSTANT adModeReadWrite adModeShareDenyRead CONSTANT adModeShareDenyRead adModeShareDenyWrite CONSTANT adModeShareDenyWrite adModeShareExclusive CONSTANT adModeShareExclusive adModeShareDenyNone CONSTANT adModeShareDenyNone adModeRecursive CONSTANT adModeRecursive \ CursorTypeEnum adOpenUnspecified CONSTANT adOpenUnspecified adOpenForwardOnly CONSTANT adOpenForwardOnly adOpenKeyset CONSTANT adOpenKeyset adOpenDynamic CONSTANT adOpenDynamic adOpenStatic CONSTANT adOpenStatic \ LockTypeEnum adLockUnspecified CONSTANT adLockUnspecified adLockReadOnly CONSTANT adLockReadOnly adLockPessimistic CONSTANT adLockPessimistic adLockOptimistic CONSTANT adLockOptimistic adLockBatchOptimistic CONSTANT adLockBatchOptimistic \ DataTypeEnum adEmpty CONSTANT adEmpty adTinyInt CONSTANT adTinyInt adSmallInt CONSTANT adSmallInt adInteger CONSTANT adInteger adBigInt CONSTANT adBigInt adUnsignedTinyInt CONSTANT adUnsignedTinyInt adUnsignedSmallInt CONSTANT adUnsignedSmallInt adUnsignedInt CONSTANT adUnsignedInt adUnsignedBigInt CONSTANT adUnsignedBigInt adSingle CONSTANT adSingle adDouble CONSTANT adDouble adCurrency CONSTANT adCurrency adDecimal CONSTANT adDecimal adNumeric CONSTANT adNumeric adBoolean CONSTANT adBoolean adError CONSTANT adError adUserDefined CONSTANT adUserDefined adVariant CONSTANT adVariant adIDispatch CONSTANT adIDispatch adIUnknown CONSTANT adIUnknown adGUID CONSTANT adGUID adDate CONSTANT adDate adDBDate CONSTANT adDBDate adDBTime CONSTANT adDBTime adDBTimeStamp CONSTANT adDBTimeStamp adBSTR CONSTANT adBSTR adChar CONSTANT adChar adVarChar CONSTANT adVarChar adLongVarChar CONSTANT adLongVarChar adWChar CONSTANT adWChar adVarWChar CONSTANT adVarWChar adLongVarWChar CONSTANT adLongVarWChar adBinary CONSTANT adBinary adVarBinary CONSTANT adVarBinary adLongVarBinary CONSTANT adLongVarBinary adChapter CONSTANT adChapter adFileTime CONSTANT adFileTime adPropVariant CONSTANT adPropVariant adVarNumeric CONSTANT adVarNumeric adArray CONSTANT adArray \ free the type library free-lasttypelib \ *Z |
|
From: Tom D. <phe...@us...> - 2006-08-19 02:35:50
|
Update of /cvsroot/win32forth/win32forth/demos/ADO In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv25241/ADO Log Message: Directory /cvsroot/win32forth/win32forth/demos/ADO added to the repository |
|
From: Tom D. <phe...@us...> - 2006-08-19 01:52:55
|
Update of /cvsroot/win32forth/win32forth/src/lib In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv8269/src/lib Added Files: Unicode.F Log Message: Unicode words for working with api calls that require unicode. This was originally part of FCOM.f, but moved into it's own file. --- NEW FILE: Unicode.F --- \ Unicode Words \ Tom Dixon \ *D doc \ *! Unicode \ *T Unicode Wordset \ *Q Tom Dixon - August 2006 \ ** Unicode wordset for working with Unicode APIs anew -Unicode.f winlibrary OLE32.DLL 6 proc MultiByteToWideChar 8 proc WideCharToMultiByte 1 proc SysStringByteLen 2 proc SysAllocStringLen 1 proc SysFreeString : UniPlace ( addr len destaddr -- ) \ *G Store a unicode string to an address 2dup ! 4 + 2dup + 0 swap w! swap cmove ; : +UniPlace ( addr len destaddr -- ) \ *G Append a string to the end of an address 2dup @ + >r dup >r dup @ + 4 + 2dup + 0 swap ! swap cmove r> r> swap ! ; : UniCount ( addr -- addr len ) \ *G Fetch a unicode string from an address (stored with uniplace) dup 4 + swap @ ; : ZUniCount ( addr -- addr len ) \ *G Fetch a null-terminated unicode string from an address (null is 16-bit) dup 0 begin over w@ while 2 2 d+ repeat nip ; : UniType ( addr len -- ) \ *G Type a unicode string to the console 2/ 0 ?do dup i 2* + c@ emit loop drop ; : (U") r> UniCount 2dup + 2 + aligned >r ; : Ustr, ( addr n -- ) \ *G Store a unicode string to the dictionary at HERE HERE over 6 + allot uniplace ALIGN ; : Asc>Uni ( str len -- str len ) \ !!! MUST FREE STRING AFTER !!! \ *G Convert a ascii string to unicode.\n \ ** must free unicode string with 'free' when no longer needed. dup 2* dup allocate abort" Unable to Allocate Unicode String!" dup >r 2swap swap MB_PRECOMPOSED 0 MultiByteToWideChar r> swap 2* ; : Uni>Asc ( str len -- str len ) \ !!! MUST FREE STRING AFTER !!! \ *G Convert a unicode string to ascii\n \ ** must free ascii string afterwards when no longer needed. 0 0 2over 0 here 2swap swap 0 0 WideCharToMultiByte 2/ >r 0 0 2swap r@ dup Allocate abort" Unable to Allocate String!" dup >r 2swap swap 0 0 WideCharToMultiByte drop r> r> ; : >Unicode ( str len -- str len ) \ *G Convert ascii string to unicode (uses new$) asc>uni 2dup new$ dup >r uniplace drop free drop r> unicount ; : >ascii ( str len -- str len ) \ *G Convert unicode string to ascii (uses new$) uni>asc 2dup new$ dup >r place drop free drop r> count ; : U" ( ... " -- str len ) \ *G Unicode string - same as s" STATE @ IF COMPILE (U") ascii " PARSE asc>uni 2dup ustr, drop free drop EXIT THEN ascii " PARSE >unicode ; IMMEDIATE \ Some APIs require more specific conditions to their unicode strings. \ (ie: distributed and network apis) \ bstr has more constraints applied to it. These words are to convert \ to bstrs and back again. : Asc>bstr ( str len -- bstr ) \ *G Convert ascii string to unicode bstr. bstr must be freed later with 'bstrfree'. dup dup 0 SysAllocStringLen dup >r 2swap swap MB_PRECOMPOSED CP_ACP MultiByteToWideChar drop r> ; : bstrFree ( bstr -- ) \ *G Free a bstr. SysFreeString drop ; : bstrlen ( ustr -- len ) \ *G Returns the length of the bstr. From this the bstr can be used with all the \ ** other unicode functions. cell- @ ; \ *Z |
|
From: Tom D. <phe...@us...> - 2006-08-19 01:51:17
|
Update of /cvsroot/win32forth/win32forth/src/lib In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv7434/src/lib Modified Files: FCOM.F Log Message: Newer version of FCOM added. This contains a fix to the dispatch interface. It also has moved the unicode words into another file, where it is better suited. Index: FCOM.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/FCOM.F,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** FCOM.F 6 May 2006 09:28:54 -0000 1.3 --- FCOM.F 19 Aug 2006 01:50:52 -0000 1.4 *************** *** 2,5 **** --- 2,7 ---- \ Tom Dixon + needs Unicode + anew -FCOM.f *************** *** 7,23 **** external ! winlibrary OLE32.DLL 1 proc CoInitialize 5 proc CoCreateInstance - 6 proc MultiByteToWideChar - 8 proc WideCharToMultiByte 2 proc CLSIDFromProgID 2 proc StringFromCLSID 2 proc CLSIDFromString - - - winlibrary oleaut32.dll - 5 proc LoadRegTypeLib 2 proc LoadTypeLib --- 9,20 ---- external ! ! winlibrary oleaut32.dll 1 proc CoInitialize 5 proc CoCreateInstance 2 proc CLSIDFromProgID 2 proc StringFromCLSID 2 proc CLSIDFromString 5 proc LoadRegTypeLib 2 proc LoadTypeLib *************** *** 29,67 **** [UNDEFINED] ISTR= [IF] synonym ISTR= STR(NC)= [THEN] - \ unicode string functions - - : UniPlace ( addr len destaddr -- ) 2dup ! 4 + 2dup + 0 swap w! swap cmove ; - : UniAppend ( addr len destaddr -- ) - 2dup @ + >r dup >r dup @ + 4 + 2dup + 0 swap ! swap cmove r> r> swap ! ; - : UniCount ( addr -- addr len ) dup 4 + swap @ ; - : ZUniCount ( addr -- addr len ) dup 0 begin over w@ while 2 2 d+ repeat nip ; - : UniType ( addr len -- ) 2/ 0 ?do dup i 2* + c@ emit loop drop ; - - : (U") r> UniCount 2dup + 2 + aligned >r ; - - : Ustr, ( addr n -- ) HERE over 6 + allot uniplace ALIGN ; - - : Asc>Uni ( str len -- str len ) \ !!! MUST FREE STRING AFTER !!! - dup 2* dup allocate abort" Unable to Allocate Unicode String!" - dup >r 2swap swap MB_PRECOMPOSED 0 MultiByteToWideChar r> swap 2* ; - - : Uni>Asc ( str len -- str len ) \ !!! MUST FREE STRING AFTER !!! - 0 0 2over 0 here 2swap swap 0 0 WideCharToMultiByte >r - 0 0 2swap r> dup Allocate abort" Unable to Allocate String!" - dup >r 2swap swap 0 0 WideCharToMultiByte drop r> zcount ; - - : >Unicode ( str len -- str len ) - asc>uni 2dup new$ dup >r uniplace drop free drop r> unicount ; - - : >ascii ( str len -- str len ) \ convert unicode to ascii - uni>asc 2dup new$ dup >r place drop free drop r> count ; - - : U" STATE @ IF COMPILE (U") ascii " PARSE - asc>uni 2dup ustr, drop free drop EXIT THEN - ascii " PARSE >unicode ; IMMEDIATE - - - - \ Defining GUIDs --- 26,29 ---- *************** *** 965,974 **** create VTstack 16 maxvt * allot \ stack DISPPARAMS Struct DispCall \ calling structure ! vtstack DispCall rgvarg ! VARIANT Struct RetVT \ return value - only one allowed :-( : vt@ ( addr -- n VT ) dup w@ swap 8 + over argcells 2 = if 2@ rot else @ swap then ; --- 927,940 ---- create VTstack 16 maxvt * allot \ stack + create VTNStack DISPID_PROPERTYPUT , DISPPARAMS Struct DispCall \ calling structure ! vtstack DispCall rgvarg ! ! vtnstack Dispcall rgdispidNamedArgs ! VARIANT Struct RetVT \ return value - only one allowed :-( + external + : vt@ ( addr -- n VT ) dup w@ swap 8 + over argcells 2 = if 2@ rot else @ swap then ; *************** *** 976,981 **** 2dup w! 8 + swap argcells 2 = if 2! else ! then ; - external - : VT> ( -- n VT ) \ pop virtual type off stack DispCall cargs @ ?dup if 1- dup DispCall cargs ! --- 942,945 ---- *************** *** 992,995 **** --- 956,961 ---- argcells 2 = if d. else . then loop ; + : retVT@ ( -- n VT ) RetVT vt@ ; + internal *************** *** 998,1002 **** : DispatchCall ( type ID Interface -- hres ) \ Call IDispatch Invoke method 2>r >r disperr 0 RetVT DispCall r> 0 GUID_NULL 2r> UCOM IDispatch Invoke ! 0 DispCall cargs ! ; : GetDispID ( ustr Interface -- ID ) \ Get Dispatch ID --- 964,968 ---- : DispatchCall ( type ID Interface -- hres ) \ Call IDispatch Invoke method 2>r >r disperr 0 RetVT DispCall r> 0 GUID_NULL 2r> UCOM IDispatch Invoke ! 0 DispCall cargs ! 0 DispCall cnamedargs ! ; : GetDispID ( ustr Interface -- ID ) \ Get Dispatch ID *************** *** 1005,1010 **** : methkind ( str len -- ustr kind ) ! over 6 s" PutRef" Istr= if 3 /string >unicode drop INVOKE_PROPERTYPUTREF exit then ! over 3 s" Put" Istr= if 3 /string >unicode drop INVOKE_PROPERTYPUT exit then over 3 s" Get" Istr= if 3 /string >unicode drop INVOKE_PROPERTYGET exit then >unicode drop INVOKE_FUNC ; --- 971,979 ---- : methkind ( str len -- ustr kind ) ! over 6 s" PutRef" Istr= if 3 /string >unicode drop INVOKE_PROPERTYPUTREF ! 1 DispCall cnamedargs ! exit then ! over 3 s" Put" Istr= if 3 /string >unicode drop INVOKE_PROPERTYPUT ! DISPID_PROPERTYPUT VTNStack ! ! 1 DispCall cnamedargs ! exit then over 3 s" Get" Istr= if 3 /string >unicode drop INVOKE_PROPERTYGET exit then >unicode drop INVOKE_FUNC ; *************** *** 1105,1111 **** )) - \ 2 5 typelib {00000205-0000-0010-8000-00AA006D2EA4} - \ 1 0 typelib {CA8A9783-280D-11CF-A24D-444553540000} - - \ IDispatch comiface disp - \ disp IDispatch 1 0 RecordSet CoCreateInstance . --- 1074,1075 ---- |
|
From: George H. <geo...@us...> - 2006-08-17 12:08:09
|
Update of /cvsroot/win32forth/win32forth/src/Compat In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv24896/win32forth/src/Compat Modified Files: OldPaths.f Log Message: gah:Corrected Id: Index: OldPaths.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Compat/OldPaths.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** OldPaths.f 17 Aug 2006 12:00:29 -0000 1.1 --- OldPaths.f 17 Aug 2006 12:08:04 -0000 1.2 *************** *** 1,3 **** ! \ Id:$ $ \ G.Hubert Thursday, August 10 2006 --- 1,3 ---- ! \ $Id$ \ G.Hubert Thursday, August 10 2006 |
|
From: George H. <geo...@us...> - 2006-08-17 12:00:32
|
Update of /cvsroot/win32forth/win32forth/src/Compat In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv21968/win32forth/src/Compat Added Files: KernelFiles42.f OldPaths.f Log Message: gah:Added files which can optionally be loaded for compatibility with older versions of W32F --- NEW FILE: KernelFiles42.f --- \ $Id: KernelFiles42.f,v 1.1 2006/08/17 12:00:29 georgeahubert Exp $ \ G.Hubert Thursday, August 12 2004 \ Public Domain \ These implementations of the original file words from the V4.2 Kernel \ are provided for use in testing legacy code. The words are rarely \ used, even in older applications (since the ANSI words are available). : FOPEN-FILE ( addr len fam -- fileid ior ) if r/w else r/o then open-file ; : FMAKE-FILE ( addr len -- fileid ior ) r/w create-file ; ' close-file alias Fclose-file ' read-line alias Fread-line : FREAD-FILE ( addr len fileid -- len ) read-file drop ; : FSEEK-FILE ( offset origin fileid -- ior ) 2>R s>d r> r> case 0 of reposition-file endof 1 of advance-file endof 2 of dup file-append >r advance-file r> or endof 3drop -1 swap endcase ; ' reposition-file alias FREPOSITION-FILE \ this function only returns a single precision position, so high part is \ always zero, and it can't fail, so error is always zero ' file-position alias FFILE-POSITION --- NEW FILE: OldPaths.f --- \ Id:$ $ \ G.Hubert Thursday, August 10 2006 \ This file should be included in legacy programs which make use of the earlier (and more \ limited) functionality provided prior to V6.11.10 warning @ warning off checkstack create &fpath MAX-PATH 1+ allot \ a static forth path buffer &fpath off &fpath value path-ptr internal path: temp-path-ptr : set-temp-path-ptr ( -- addr ) path-ptr temp-path-ptr tuck max-path 1+ move ; : ("path-file) ( addr1 len1 -- addr2 len2 f ) \ might not be needed? set-temp-path-ptr full-path ; external : Path-source ( -- addr ) temp-path-ptr path-source ; : First-path" ( -- addr len ) set-temp-path-ptr first-path" ; : Next-path" ( -- addr len ) set-temp-path-ptr next-path" ; module warning ! |
|
From: George H. <geo...@us...> - 2006-08-17 11:57:55
|
Update of /cvsroot/win32forth/win32forth/src/Compat In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv20679/Compat Log Message: Directory /cvsroot/win32forth/win32forth/src/Compat added to the repository |
|
From: Jos v.d.V. <jo...@us...> - 2006-08-13 11:43:52
|
Update of /cvsroot/win32forth/win32forth/src/lib In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv22910/src/lib Modified Files: multithr.f Log Message: Jos: Added \in-system-ok to prevent a warning Index: multithr.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/multithr.f,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** multithr.f 17 May 2005 22:25:26 -0000 1.3 --- multithr.f 13 Aug 2006 10:52:02 -0000 1.4 *************** *** 155,159 **** : create-thread-user: ! 0 0 task-block constant ; \s --- 155,159 ---- : create-thread-user: ! \in-system-ok 0 0 task-block constant ; \s |
|
From: Dirk B. <db...@us...> - 2006-08-13 07:59:08
|
Update of /cvsroot/win32forth/win32forth/src/lib In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv21183/src/lib Modified Files: ScintillaLexer.f Log Message: - IN-PREVIOUS added. It restores the data area after a call to IN-APPLICATION IN-SYSTEM or IN-CODE. Index: ScintillaLexer.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/ScintillaLexer.f,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** ScintillaLexer.f 17 Dec 2005 15:15:07 -0000 1.5 --- ScintillaLexer.f 13 Aug 2006 07:59:00 -0000 1.6 *************** *** 67,81 **** create UserWords2 ! ,{ ENVIRONMENT? MARKER DEFINITIONS ALSO ONLY PREVIOUS ANEW INTERNAL PRIVATE EXTERNAL MODULE } ! ,{ IN-APPLICATION IN-SYSTEM SYS-WARNING-OFF SYS-WARNING-ON IMMEDIATE POSTPONE } ! ,{ ' ['] [CHAR] [COMPILE] \IN-SYSTEM-OK \- \+ IN-CODE } ! ,{ #LEXICON LEXICON #VOCABULARY VOCABULARY } create UserWords3 ,{ [DEFINED] [UNDEFINED] [IF] [ELSE] [THEN] [ENDIF] } ! ,{ #IF #ELSE #THEN #ENDIF #IFDEF #IFNDEF } ,{ [ ] } ! ,{ INCLUDE-FILE INCLUDED $FLOAD FLOAD SYS-FLOAD OK "FLOAD INCLUDE NEEDS } ,{ FSAVE TURNKEY APPLICATION } create UserWords4 --- 67,85 ---- create UserWords2 ! ,{ VOCABULARY DEFINITIONS ALSO ONLY PREVIOUS } ! ,{ IN-APPLICATION IN-SYSTEM IN-CODE IN-PREVIOUS \IN-SYSTEM-OK \- \+ } ! ,{ SYS-WARNING-OFF SYS-WARNING-ON } ! ,{ MARKER ANEW INTERNAL PRIVATE EXTERNAL MODULE } ! ,{ ' ['] [CHAR] [COMPILE] POSTPONE IMMEDIATE } ! ,{ #LEXICON LEXICON #VOCABULARY } ! ,{ ENVIRONMENT? } create UserWords3 ,{ [DEFINED] [UNDEFINED] [IF] [ELSE] [THEN] [ENDIF] } ! ,{ #IFDEF #IFNDEF #IF #ELSE #THEN #ENDIF } ,{ [ ] } ! ,{ INCLUDE-FILE INCLUDED $FLOAD FLOAD SYS-FLOAD "FLOAD INCLUDE NEEDS } ,{ FSAVE TURNKEY APPLICATION } + ,{ OK } create UserWords4 |
|
From: Dirk B. <db...@us...> - 2006-08-13 07:59:08
|
Update of /cvsroot/win32forth/win32forth/src/kernel In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv21183/src/kernel Modified Files: fkernel.f Log Message: - IN-PREVIOUS added. It restores the data area after a call to IN-APPLICATION IN-SYSTEM or IN-CODE. Index: fkernel.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/kernel/fkernel.f,v retrieving revision 1.33 retrieving revision 1.34 diff -C2 -d -r1.33 -r1.34 *** fkernel.f 4 Aug 2006 09:48:43 -0000 1.33 --- fkernel.f 13 Aug 2006 07:58:59 -0000 1.34 *************** *** 3043,3047 **** CREATE CDP 0 , 0 , 0 , DP-LINK LINK, ," CODE" \ code ! ADP VALUE DP \ data pointer defaults to app space \ ----------------- Switching dictionary words --------------- --- 3043,3048 ---- CREATE CDP 0 , 0 , 0 , DP-LINK LINK, ," CODE" \ code ! ADP VALUE DP \ data pointer defaults to app space ! ADP VALUE ODP \ data pointer defaults to app space \ ----------------- Switching dictionary words --------------- *************** *** 3052,3057 **** \ \ IN-xxxx is used in open code to switch HERE ALLOT , W, etc to point ! \ to the specific data area; no save is made of the current DP, so ! \ it has to be reset back explicitly. \ \ >XXXX and XXXX> move to and from a specific data area, and save the --- 3053,3058 ---- \ \ IN-xxxx is used in open code to switch HERE ALLOT , W, etc to point ! \ to the specific data area; the current DP is saved in ODP, so ! \ it can be reseted using IN-PREVIOUS. \ \ >XXXX and XXXX> move to and from a specific data area, and save the *************** *** 3060,3066 **** \ ! : IN-APPLICATION ( -- ) ADP TO DP ; \ set the correct pointer ! : IN-SYSTEM ( -- ) SDP TO DP ; ! : IN-CODE ( -- ) CDP TO DP ; : >DP ( dp -- ) R>DROP DP R> 2>R TO DP ; \ save the current DP, set new --- 3061,3079 ---- \ ! : IN-APPLICATION ( -- ) \ w32f ! \ *G Activate the application data area. ! DP TO ODP ADP TO DP ; ! ! : IN-SYSTEM ( -- ) \ w32f ! \ *G Activate the system data area. ! DP TO ODP SDP TO DP ; ! ! : IN-CODE ( -- ) \ w32f ! \ *G Activate the code data area. ! DP TO ODP CDP TO DP ; ! ! : IN-PREVIOUS ( -- ) \ w32f ! \ *G Restore the data area after a call to IN-APPLICATION IN-SYSTEM or IN-CODE. ! ODP TO DP ; : >DP ( dp -- ) R>DROP DP R> 2>R TO DP ; \ save the current DP, set new |
|
From: George H. <geo...@us...> - 2006-08-11 10:09:51
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv7286/win32forth/src Modified Files: ANSFILE.F GENERIC.F POINTER.F Primutil.f SEE.F paths.f Log Message: gah:Made GETTEXT$ in GENERIC.F thread-safe, added code to see pointers and minor mods Index: ANSFILE.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/ANSFILE.F,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** ANSFILE.F 13 Mar 2006 14:16:51 -0000 1.4 --- ANSFILE.F 11 Aug 2006 10:09:45 -0000 1.5 *************** *** 142,147 **** 5 (DOSTime) ; - module - : get-file-size ( -- size ) \ need to call find-first-file or find-next-file word --- 142,145 ---- *************** *** 155,159 **** 2 cells newuser file-time-buf ! : get-file-modified ( fileid -- system-time ) --- 153,158 ---- 2 cells newuser file-time-buf ! \ *G 2Variable to hold the FILETIME structure, which is a little endian (i.e. reversed order) ! \ ** 64-bit value representing the number of 100-nanosecond intervals since January 1, 1601. : get-file-modified ( fileid -- system-time ) *************** *** 287,288 **** --- 286,290 ---- IN-APPLICATION + module + + \ *Z Index: GENERIC.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/GENERIC.F,v retrieving revision 1.13 retrieving revision 1.14 diff -C2 -d -r1.13 -r1.14 *** GENERIC.F 11 Jun 2006 07:37:27 -0000 1.13 --- GENERIC.F 11 Aug 2006 10:09:45 -0000 1.14 *************** *** 269,273 **** then ;M ! named-new$ gettext$ :M GetText: ( -- addr len ) --- 269,273 ---- then ;M ! maxstring newuser gettext$ :M GetText: ( -- addr len ) Index: paths.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/paths.f,v retrieving revision 1.23 retrieving revision 1.24 diff -C2 -d -r1.23 -r1.24 *** paths.f 5 Aug 2006 12:27:39 -0000 1.23 --- paths.f 11 Aug 2006 10:09:45 -0000 1.24 *************** *** 287,291 **** : FindRelativeName ( a1 n1 path-ptr - a2 n2 f ) ! \ *G Returns a releative name for file a1 n1 in path-ptr ( last-part ). \n \ ** n2=0 means not in search path. >r 2dup r> FindRelativePath dup 0> --- 287,291 ---- : FindRelativeName ( a1 n1 path-ptr - a2 n2 f ) ! \ *G Returns a relative name for file a1 n1 in path-ptr ( last-part ). \n \ ** n2=0 means not in search path. >r 2dup r> FindRelativePath dup 0> *************** *** 313,317 **** : "LOADED? ( addr len -- flag ) ! \ *G True if a file addr len is loaded. The filename must cointain a full path. CONTEXT @ >R \ save context files \ set context --- 313,317 ---- : "LOADED? ( addr len -- flag ) ! \ *G True if a file addr len is loaded. The filename must contain a full path. CONTEXT @ >R \ save context files \ set context *************** *** 333,357 **** : \LOADED- ( -<name>- ) \ *G If the following file IS NOT LOADED interpret line. ! >in @ >r ! loaded? 0= ! if interpret ! else postpone \ ! then r>drop ; : \LOADED ( -<name>- ) \ *G If the following file IS LOADED interpret line. ! >in @ >r ! loaded? ! if interpret ! else postpone \ ! then r>drop ; : NEEDS ( -<name>- ) \ *G Conditionally load file "name" if not loaded. ! >in @ >r ! loaded? 0= \ if file isn't loaded ! if r@ >in ! ! fload \ then loadit ! then r>drop ; synonym Require needs --- 333,345 ---- : \LOADED- ( -<name>- ) \ *G If the following file IS NOT LOADED interpret line. ! loaded? if postpone \ then ; : \LOADED ( -<name>- ) \ *G If the following file IS LOADED interpret line. ! loaded? 0= if postpone \ then ; : NEEDS ( -<name>- ) \ *G Conditionally load file "name" if not loaded. ! >in @ loaded? 0= if >in ! fload else drop then ; synonym Require needs Index: POINTER.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/POINTER.F,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** POINTER.F 8 Aug 2006 14:09:08 -0000 1.8 --- POINTER.F 11 Aug 2006 10:09:45 -0000 1.9 *************** *** 5,13 **** cr .( Loading Memory Pointer...) ! \ BODY +0 +4 +8 +12 ! \ [ phy_pointer ][ link ][ size_bytes ][ ptr->link ] in-application VARIABLE PHEAD PHEAD OFF --- 5,15 ---- cr .( Loading Memory Pointer...) ! \ BODY +0 +4 +8 | +12 ( removed) ! \ [ phy_pointer ][ link ][ size_bytes ] | [ ptr->link ] in-application + internal + VARIABLE PHEAD PHEAD OFF *************** *** 20,23 **** --- 22,35 ---- initialization-chain chain-add pointers-init + cfa-func DoPointer ( -- address ) \ it's location + dup @ if @ exit then \ ok, straight fetch + dup (pointerlock) + @ if (pointerunlock) @ exit then \ another task won the race + dup 2 cells+ @ allocate 0= + if dup off \ set first cell to zeros + tuck swap ! (pointerunlock) exit + then (pointerunlock) 1- + abort" Failed to allocate POINTER" ; + in-system *************** *** 34,63 **** forget-chain chain-add trim-pointers ! :NONAME ( link -- ) \ .POINTERS ! DUP CELL- BODY> >R ! CR DUP CELL+ @ 10 U,.R ." bytes at: " ! CELL- @ ?DUP IF 13 H.R ELSE ." <unallocated>" ! THEN ." for: " R> .NAME ; : .POINTERS ( -- ) LITERAL [ !CSP ] \ make sure CSP is adjusted PHEAD DO-LINK ; \ from noname above ! in-application ! : ?VALID_POINTER ( plink -- plink ) \ check for valid pointer sturcture ! TURNKEYED? ?EXIT \ no point if this is turnkeyed ! DUP 2 cells+ @ OVER <> ! IF cell - BODY> DUP CR h. ! \IN-SYSTEM-OK .name ." is NOT a valid POINTER structure!" ABORT THEN ; : %UnPointer ( cfa -- ) \ deallocate pointer given the cfa ! >BODY DUP @ 0<> \ only if non-zero (added missing 0<> February 6th, 2004 - 18:35 dbu) ! IF DUP cell+ ?VALID_POINTER DROP ! DUP @ release \ release the memory off \ clear the memory pointer ELSE DROP --- 46,87 ---- forget-chain chain-add trim-pointers ! : (.Pointer) ( pfa -- ) ! dup 2 cells+ @ 10 U,.R ." bytes at: " ! @ ?DUP IF 13 H.R ELSE ." <unallocated>" ! THEN ; ! ! : .Pointer ( cfa -- ) ! ." POINTER " dup .name >body (.Pointer) ; ! ! external ! ! :NONAME ( link -- ) \ .POINTERS ! cr CELL- dup>r (.Pointer) ." for: " R> body> .NAME ; : .POINTERS ( -- ) LITERAL [ !CSP ] \ make sure CSP is adjusted PHEAD DO-LINK ; \ from noname above ! internal ! : (IsPointer?) ( plink -- plink ) \ check for valid pointer structure ! DUP @ Dopointer <> ! IF DUP CR h. ! .name ." is NOT a valid POINTER structure!" ABORT THEN ; + in-application + + : IsPointer? ( cfa -- cfa ) \ check for valid pointer structure + \in-system-ok TURNKEYED? ?EXIT (IsPointer?) ; \ no point if this is turnkeyed + + external + : %UnPointer ( cfa -- ) \ deallocate pointer given the cfa ! IsPointer? >BODY DUP @ 0<> \ only if non-zero (added missing 0<> February 6th, 2004 - 18:35 dbu) ! IF DUP @ release \ release the memory off \ clear the memory pointer ELSE DROP *************** *** 65,69 **** : >POINTER ( cfa -- ptr ) \ move to ptr ! >BODY cell+ ?VALID_POINTER cell+ ; : %SizeOf! ( bytes cfa -- ) \ set the size of pointer "cfa" --- 89,93 ---- : >POINTER ( cfa -- ptr ) \ move to ptr ! IsPointer? >BODY 2 cells+ ; : %SizeOf! ( bytes cfa -- ) \ set the size of pointer "cfa" *************** *** 88,101 **** then (pointerunlock) ; - : DOES>Pointer ( -- address ) \ it's location - DOES> - dup @ if @ exit then \ ok, straight fetch - dup (pointerlock) - @ if (pointerunlock) @ exit then \ another task won the race - dup 2 cells+ @ allocate 0= - if dup off \ set first cell to zeros - tuck swap ! (pointerunlock) exit - then (pointerunlock) 1- - abort" Failed to allocate POINTER" ; in-system --- 112,115 ---- *************** *** 104,112 **** >APPLICATION \ always in app space 128 max \ at least 160 bytes ! CREATE 0 , \ initialize to unallocated HERE PHEAD @ , PHEAD ! \ link into chain , \ lay in size in bytes - PHEAD @ , \ POINTER CHAIN verify word - DOES>Pointer APPLICATION> ; \ back to where we came from --- 118,124 ---- >APPLICATION \ always in app space 128 max \ at least 160 bytes ! header DoPointer compile, 0 , \ initialize to unallocated HERE PHEAD @ , PHEAD ! \ link into chain , \ lay in size in bytes APPLICATION> ; \ back to where we came from *************** *** 169,170 **** --- 181,186 ---- initialization-chain chain-add init-new$ + module + + \ *Z + Index: SEE.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/SEE.F,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** SEE.F 3 Aug 2006 13:08:22 -0000 1.7 --- SEE.F 11 Aug 2006 10:09:45 -0000 1.8 *************** *** 291,294 **** --- 291,295 ---- dovoc of .vocabulary endof doObj of .object endof + doPointer of .pointer endof swap .other endcase ; Index: Primutil.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Primutil.f,v retrieving revision 1.16 retrieving revision 1.17 diff -C2 -d -r1.16 -r1.17 *** Primutil.f 5 Aug 2006 12:30:52 -0000 1.16 --- Primutil.f 11 Aug 2006 10:09:45 -0000 1.17 *************** *** 118,122 **** \ September 16th, 2003 - 10:27 dbu : cfa-func ( -<name>- ) ! header docon compile, code-here , hide !csp dodoes-call, ] ; defer enter-assembler ' noop is enter-assembler --- 118,122 ---- \ September 16th, 2003 - 10:27 dbu : cfa-func ( -<name>- ) ! header docon compile, ( code-here , ) hide !csp dodoes-call, ] ; defer enter-assembler ' noop is enter-assembler |
|
From: Rod O. <rod...@us...> - 2006-08-10 22:52:22
|
Update of /cvsroot/win32forth/win32forth/apps/PictureViewer In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv3155/apps/PictureViewer Modified Files: PVResources.f Log Message: Rod: Put manifest for XP visual styles into resources. Index: PVResources.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/PictureViewer/PVResources.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** PVResources.f 24 Jul 2006 21:22:37 -0000 1.1 --- PVResources.f 10 Aug 2006 22:52:18 -0000 1.2 *************** *** 13,16 **** --- 13,17 ---- pad count "path-file drop AddToFile + CREATEPROCESS_MANIFEST_RESOURCE_ID RT_MANIFEST s" PictureViewer.exe.manifest" "path-file drop AddResource 149 s" Res\HandOpen.cur" "path-file drop AddCursor \ 150 s" Res\HandClosed.cur" "path-file drop AddCursor |
|
From: Rod O. <rod...@us...> - 2006-08-10 22:51:53
|
Update of /cvsroot/win32forth/win32forth/apps/PictureViewer In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv2779/apps/PictureViewer Modified Files: PVToolbar.f Log Message: Rod: Added TBSTYLE_TRANSPARENT to stop flicker with XP visual style Index: PVToolbar.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/PictureViewer/PVToolbar.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** PVToolbar.f 24 Jul 2006 21:22:37 -0000 1.1 --- PVToolbar.f 10 Aug 2006 22:51:46 -0000 1.2 *************** *** 86,89 **** --- 86,90 ---- WS_VISIBLE invert and \ start hidden CBS_SORT or + WS_CLIPCHILDREN or ;M *************** *** 227,230 **** --- 228,233 ---- TBSTYLE_TOOLTIPS or CCS_ADJUSTABLE or + TBSTYLE_TRANSPARENT or + WS_CLIPCHILDREN or WS_CLIPSIBLINGS or ;M |
1040 messages has been excluded from this view by a project administrator.
