Menu
▾
▴
[GeSHi-commit] SF.net SVN: geshi:[2008] branches/MISC_STUFF/coderepo
|
From: <be...@us...> - 2009-02-15 12:12:04
|
Revision: 2008
http://geshi.svn.sourceforge.net/geshi/?rev=2008&view=rev
Author: benbe
Date: 2009-02-15 12:11:57 +0000 (Sun, 15 Feb 2009)
Log Message:
-----------
add: Added sample sources for Rebol
Added Paths:
-----------
branches/MISC_STUFF/coderepo/rebol/
branches/MISC_STUFF/coderepo/rebol/days-between.r
branches/MISC_STUFF/coderepo/rebol/ping32.r
Property changes on: branches/MISC_STUFF/coderepo/rebol
___________________________________________________________________
Added: bugtraq:url
+ http://sourceforge.net/tracker/index.php?func=detail&aid=%BUGID%&group_id=114997&atid=670231
Added: bugtraq:logregex
+ (SF)?\s*#\d+
(\d+)
Added: branches/MISC_STUFF/coderepo/rebol/days-between.r
===================================================================
--- branches/MISC_STUFF/coderepo/rebol/days-between.r (rev 0)
+++ branches/MISC_STUFF/coderepo/rebol/days-between.r 2009-02-15 12:11:57 UTC (rev 2008)
@@ -0,0 +1,38 @@
+REBOL [
+ title: "Days Between"
+ date: 9-feb-2009
+ file: %days-between.r
+ author: Nick Antonaccio
+ purpose: {
+ Compute the number of days between any two dates - super simple GUI example.
+ }
+]
+
+sd: ed: now/date
+
+view layout [
+ btn "Select Start Date" [
+ sd: request-date
+ db/text: (ed - sd)
+ sdt/text: sd
+ show sdt
+ show db
+ ]
+ sdt: field to-string sd [
+ db/text: ((to-date edt/text) - (to-date sdt/text))
+ show db
+ ]
+ btn "Select End Date" [
+ ed: request-date
+ edt/text: ed
+ db/text: (ed - sd)
+ show edt
+ show db
+ ]
+ edt: field to-string ed [
+ db/text: ((to-date edt/text) - (to-date sdt/text))
+ show db
+ ]
+ h1 "Days Between:"
+ db: field to-string ((to-date edt/text) - (to-date sdt/text))
+]
Property changes on: branches/MISC_STUFF/coderepo/rebol/days-between.r
___________________________________________________________________
Added: svn:eol-style
+ native
Added: branches/MISC_STUFF/coderepo/rebol/ping32.r
===================================================================
--- branches/MISC_STUFF/coderepo/rebol/ping32.r (rev 0)
+++ branches/MISC_STUFF/coderepo/rebol/ping32.r 2009-02-15 12:11:57 UTC (rev 2008)
@@ -0,0 +1,144 @@
+REBOL [
+ Title: "Ping using Win32 API"
+ File: %ping32.r
+ Date: 28-Dec-2008
+ Purpose: {Real (ICMP) ping using Win32 APIs}
+ Version: 1.0.0
+ Author: "Semseddin Moldibi"
+ Notes: {The code may not be perfect but it works.
+ It tries to ping given IP or host 4 times, and return on of -1,0,1,2,3,4
+ -1: if IP address can't be resolved from url,
+ 0: if ping failed (timeout etc.)
+ 1,2,3,4: number of successful pings
+ examples:
+ ping 127.0.0.1 ;should return 4
+ ping 192.168.1.1
+ ping "rebol.com"
+ ping "www.google.com"
+ ping "www.noneexistingsite.com" ;return 0
+ ping-ctx/clean-up ;to free the libraries when you are done..
+ }
+
+ Library: [
+ level: 'intermediate
+ platform: 'windows
+ type: [internet module]
+ domain: [win-api other-net]
+ tested-under: [view 2.7.6.3.1 on "WinXP Home"]
+ support: "semseddin/at/gmail.com"
+ license: 'public-domain
+ see-also: none
+ ]
+]
+
+ping-ctx: context [
+
+ ;I took this function from %get-version-ex.r (Gregg Irwin)
+ make-elements: func [name count type /local result][
+ if not word? type [type: type?/word type]
+ result: copy "^/"
+ repeat i count [
+ append result join name [i " [" type "]" newline]
+ ]
+ to block! result
+ ]
+
+ WSAData: make struct! WSAdata-def: compose/deep/only [
+ wVersion [short]
+ wHighVersion [short]
+ (make-elements 'Description 257 #"@")
+ (make-elements 'szSystemStatus 129 #"@")
+ iMaxSockets [short]
+ iMaxUdpDg [short]
+ pad [short]
+ lpVendorInfo [long]
+ ] none
+
+ IP_OPTION_INFORMATION: make struct! IP_OPTION_INFORMATION-def: compose/deep [
+ TTL [char!]
+ Tos [char!]
+ Flags [char!]
+ OptionsSize [char!]
+ OptionsData [long]
+ ] none
+
+ IP_ECHO_REPLY: make struct! IP_ECHO_REPLY-def: compose/deep/only [
+ Address [long]
+ Status [long]
+ RoundTripTime [long]
+ DataSize [short]
+ Reserved [short]
+ data [long]
+ Options [struct! (IP_OPTION_INFORMATION-def)]
+ ] none
+
+ ;load libraries
+ IcmpLib: load/library %icmp.dll
+ wsock32Lib: load/library %wsock32.dll
+
+ WSAStartup: make routine! compose/deep/only [
+ wVersionRequired [long]
+ lpWSAdata [struct! (WSAData-def)]
+ return: [long]
+ ] wsock32Lib "WSAStartup"
+
+ WSACleanup: make routine! [
+ return: [long]
+ ] wsock32Lib "WSACleanup"
+
+ IcmpCreateFile: make routine! [return: [long]] IcmpLib "IcmpCreateFile"
+ IcmpCloseHandle: make routine! [Handle [integer!] return: [long]] IcmpLib "IcmpCloseHandle"
+ IcmpSendEcho: make routine! IcmpSendEcho-def: compose/deep/only [
+ IcmpHandle [long]
+ DestAddress [long]
+ RequestData [string!]
+ RequestSize [short]
+ RequestOptns [struct! (IP_OPTION_INFORMATION-def)]
+ ReplyBuffer [struct! (IP_ECHO_REPLY-def)]
+ ReplySize [long]
+ TimeOut [long]
+ return: [long]
+ ] IcmpLib "IcmpSendEcho"
+
+ clean-up: does [
+ free wsock32Lib
+ free IcmpLib
+ ]
+
+ hPing: reqsize: RepSize: 0
+
+ set 'ping func [dst /local d] [
+ if not tuple? dst [
+ dst: read to-url join "dns://" dst
+ if not found? dst [
+ return -1 ;can't find IP address
+ ]
+ ]
+ either 0 = WSAStartup 257 WSAData [
+ IP_OPTION_INFORMATION/TTL: to-char 255
+ reply: IP_ECHO_REPLY
+ opt: IP_OPTION_INFORMATION
+ reqdat: copy "12345678901234567890123456789012" ;32 bytes
+ reqsize: length? reqdat
+ RepSize: reqsize + 28 ;28 is the length of the IP_ECHO_REPLY structure
+ ;but length? returns 24, I don't know why?
+ hPing: IcmpCreateFile
+ either 0 <> hPing [
+ d: to-integer reverse to-binary dst
+ r: 0
+ loop 4 [
+ r: r + IcmpSendEcho hPing d reqdat reqsize opt reply RepSize 2000 ;2 seconds
+ ]
+ IcmpCloseHandle hPing
+ WSACleanup
+ r
+ ][
+ make error! "Ping failed."
+ ]
+ ] [
+ make error! "Winsock initialization failed."
+ ]
+ ]
+]
+;uncomment the next line to test
+;halt
Property changes on: branches/MISC_STUFF/coderepo/rebol/ping32.r
___________________________________________________________________
Added: svn:eol-style
+ native
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|