Recent Posts

Pages: [1] 2 3 ... 10
1
General Board / FreeMyIp.Com very simple free DNS routing
« Last post by cj on June 20, 2017, 01:12:11 AM »
http://freemyip.com  Type in a name and it automtically creates a link to your local Ip address
Save the link provided and execute anytime to route to your current Ip or edit to go to another IP address.
Please report any problem.

Feel free to test as much as you want:
slConnect "sqlitening.freemyipserver.com"

#INCLUDE "sqlitening.inc"

FUNCTION PBMAIN () AS LONG 'QuickTest2.bas 6/20/17
 slconnect "sqlitening.freemyip.com"
 slOpen "sample.db3"
 ViewFile "select rowid,manuf,redref,product from parts limit 20"
 slDisconnect
END FUNCTION

FUNCTION ViewFile(SQL AS STRING) AS LONG
 LOCAL hFile AS LONG, sTempfile, sArray() AS STRING
 IF slSelAry(sql,sArray(),"Q9 E2") THEN EXIT FUNCTION
 sTempFile=GUIDTXT$(GUID$) + ".tmp"
 hFile = FREEFILE
 OPEN sTempFile FOR OUTPUT AS #hFile
 IF ERR THEN ? ERROR$,,FUNCNAME$:EXIT FUNCTION
 PRINT #hFile,"SQLitening.FreeMyIp.Com Test"
 IF ERR THEN
   ? ERROR$,,"Could not write heading " + FUNCNAME$
   EXIT FUNCTION
 END IF
 PRINT #hFile
 PRINT #hFile, sArray()
 IF ERR THEN ? ERROR$,,FUNCNAME$:EXIT FUNCTION
 CLOSE #hFile
 SHELL "write.exe " + sTempfile
 SLEEP 500
 KILL sTempfile
 IF ERR THEN ? ERROR$,,FUNCNAME$
END FUNCTION


2
You've got Questions? We've got Answers! / Re: slSetRelNamedLocks
« Last post by Fim on June 18, 2017, 06:19:06 AM »
In the version of SQLitening.Bas that I have, dated 24-Nov-2015 17:20, Frank's code is already inserted, but not Bern's correction.
And if I do the call as follows, I will not get a display of error message.
ANSWER = slSetRelNamedLocks ("+" + PA_NR_X, "E0", "", 0, "E0")

Thus, the problem is resolved.
Thanks for the help.
/Fim W
3
You've got Questions? We've got Answers! / Re: Embed Image Using SQLitening & DDOC
« Last post by cj on June 17, 2017, 03:14:56 PM »
This version still needs to write images back and forth to the local disk to load into ddoc, yuck.
Because of this the logic had to be changed for client/server.
This is fast without the server, but leaves something to be desired running on a server.

The %TestMode variable shows the pushing and popping the database back and forth between local/server.
I'm not sure if that is killing the performance.  I'll work on this more when time permits.
Switching between local and remote is now very safe, but not sure it is implemented well.

Need to investigate ddoc source or perhaps these links:
https://forum.powerbasic.com/forum/user-to-user-discussions/powerbasic-for-windows/53636-some-png-images-display-oddly?t=52321&highlight=GdipDrawImageRect

https://forum.powerbasic.com/forum/user-to-user-discussions/powerbasic-for-windows/49073-gdi-question?t=47870

https://forum.powerbasic.com/forum/user-to-user-discussions/source-code/52507-gdi-image-save-load-from-to-buffer



#COMPILE EXE
#DIM ALL
$Server = "192.168.0.2":%Port=0  'remark to run without server

%AddClients=20
%TestMode = 0  'messagebox each time switch between local and server mode
%ClientServerFlag = 9999
#INCLUDE "ddoc_p32.inc" 'requires ddoc32.dll and ddoc_jpg.dll
#INCLUDE "\sql\bin\sqlitening.inc"
THREADED ClientServer,CurrentMode AS LONG 'need to know when switching local/remote at all times
'-------------------------------------------------------------------------------------------------
FUNCTION PBMAIN () AS LONG 'ddocsample3.bas
 LOCAL x, AddClients AS LONG
 #IF %DEF($Server)
 slConnect $Server,%Port:ClientServer=%ClientServerFlag:CurrentMode=%ClientServerFlag
 #ENDIF

 slOpen "ddoc.db3","C"
 IF %AddClients > 0 THEN
  slexe "drop table if exists ClientTable"
  slexe "drop table if exists ImageTable"
 END IF

 slexe "create table if not exists ClientTable(ClientKey integer primary key,ClientName)
 slexe "create Table if not exists ImageTable(key UNIQUE, picture BLOB)"

 IF %AddClients > 0 THEN
  AddClients = %AddClients
  slexe "begin immediate"   'add some clients and images
  FOR x = 1 TO AddClients
   slexe USING$("insert into ClientTable values(null_,#)",x)
   AddImage "\arm\heidi3.bmp","ImageTable",FORMAT$(x)
  NEXT
  slexe "end"
 END IF

 ? "Ready to TestDDoc",%MB_SYSTEMMODAL,"Created tables"
 TestDDoc
 'Test
END FUNCTION

FUNCTION TestDDoc AS LONG
 LOCAL sql AS STRING
 LOCAL x,y,x2,y2 AS SINGLE
 LOCAL PrintPreview,DefaultZoom,TheBin,EndCode,iHandle,counter,hpix AS LONG
 LOCAL docTitle   AS ASCIIZ * 66
 LOCAL outputfile AS ASCIIZ * 66
 LOCAL skey AS STRING
 LOCAL sKeyArray() AS STRING
 LOCAL result AS LONG

 DIM sClientNumberArray() AS STRING   'get all client numbers into an array

 sql =  "select ClientKey from ClientTable"
 slselAry sql,sClientNumberArray(),"Q9"
 IF UBOUND(sClientNumberArray) < 1 THEN ? "No clients":EXIT FUNCTION

 #IF %DEF($Server)
 DocTitle = "CLIENT/SERVER MODE " + $Server + " on port"' + STR$(%Port)
 #ELSE
   docTitle = "LOCAL MODE"
 #ENDIF

 PrintPreview = 1
 DefaultZoom = %DDOC_ZOOM75
 TheBin = %DDOC_Bin_Auto
 IF PrintPreview THEN
  endCode = %DDOC_END_VIEW + %DDOC_END_DELETE
 ELSE
  endCode = %DDOC_END_PRINT + %DDOC_END_DELETE
  DefaultZoom+= %DDOC_VIEWBUILD 'so no dialog will appear
 END IF

 ihandle = dpStartDoc(0,DocTitle,outputfile,%DDOC_INCH,%DDOC_PAPER_LETTER,%DDOC_SYSTEM_DEFAULT,TheBin,DefaultZoom + %DDOC_VIEWBUILD)

 slSelAry sql,sKeyArray(),"Q9c"
 IF slGetErrorNumber THEN ? slGetError,%MB_ICONERROR OR %MB_SYSTEMMODAL,"No images will print"

 FOR counter = 1 TO UBOUND(sKeyarray)
  skey = skeyArray(counter)
  x =  0    'upper left column
  y  = 0    'upper left row
  x2 = 3    'low right column
  y2 = 5    'low right row
  result = slAddGraphic(iHandle,hpix,"ImageTable","picture",sKey,x,y,x2,y2)

  IF counter<> UBOUND(sKeyArray)THEN
   dpNewPage iHandle,  %ddoc_PAPER_A4, %DDOC_PORTRAIT, %DDOC_BIN_AUTO
  END IF
 NEXT
 dpEndDoc iHandle, EndCode
 'SHELL ENVIRON$("COMSPEC") + " /C taskkill.exe /F /T /IM ddoc.exe",0
END FUNCTION
'-------------------------------------------------------------------------------------------------
FUNCTION AddImage(sImageFile AS STRING,sImageTable AS STRING,sKey AS STRING) THREADSAFE AS LONG

 LOCAL result AS LONG
 LOCAL sBlob AS STRING

 result = slGetFileLocal(sImageFile,sBlob)
 IF result THEN EXIT FUNCTION

 FUNCTION = BlobToTable(sImageTable,sKey,sBlob)

END FUNCTION
'-------------------------------------------------------------------------------------------------
FUNCTION BlobToTable(sImageTable AS STRING,sKey AS STRING,sBlob AS STRING) AS LONG

 slExeBind "Replace into " + sImageTable + " values(?,?)", _
                                  slBuildBindDat(sKey,"T") + _
                                  slBuildBindDat(sBlob)
 IF slGetChangeCount <> 1 THEN
   ? "Image key " + sKey,,"slPutImage Error"
   FUNCTION = 1
 END IF

END FUNCTION
'-------------------------------------------------------------------------------------------------
FUNCTION slGetImageFromTable(sImageTable AS STRING,sImageColumn AS STRING, sKey AS STRING) AS STRING
 LOCAL sql AS STRING, counter AS LONG
 slSetProcessMods "E2"
 sql = "select " + sImageColumn + " from " + sImageTable + " where key ='" + sKey + "'"
 slsel sql
 IF slGetRow THEN FUNCTION = slf(1) ELSE ? "key not found" + $CR + sql,,FUNCNAME$:EXIT FUNCTION
END FUNCTION
'-------------------------------------------------------------------------------------------------
FUNCTION slGetFileLocal(sImageFile AS STRING,sBlob AS STRING) THREADSAFE AS LONG

 LOCAL ModeBeforeHere AS LONG
 ModeBeforeHere = CurrentMode
 IF ModeBeforeHere <> 0 THEN SwitchLocal 'we must be local mode
 FUNCTION = slGetFile(sImageFile,sBlob,"C E0")
 IF ModeBeforeHere = %ClientServerFlag THEN SwitchRemote 'switch back to remote

END FUNCTION
'-------------------------------------------------------------------------------------------------
FUNCTION slPutFileLocal(sTempFile AS STRING,sBlob AS STRING) THREADSAFE AS LONG

 LOCAL ModeBeforeHere,result AS LONG
 ModeBeforeHere = CurrentMode
 IF ModeBeforeHere <> 0 THEN SwitchLocal 'we must be local mode
 FUNCTION = slPutFile(sTempFile,sBlob,"CT E0")
 IF slGetErrorNumber THEN ? slGetError,,FUNCNAME$

 IF ModeBeforeHere = %ClientServerFlag THEN SwitchRemote 'switch back to remote

END FUNCTION
'-------------------------------------------------------------------------------------------------
FUNCTION slAddGraphic(iHandle AS LONG,hPix AS LONG,sImageTable AS STRING,sImageColumn AS STRING,sKey AS STRING, _
                      x AS SINGLE,y AS SINGLE,x2 AS SINGLE,y2 AS SINGLE) AS LONG

  LOCAL sBlob          AS STRING
  LOCAL result         AS LONG
  LOCAL sTempFile      AS STRING

  sBlob = slGetImageFromTable(sImageTable,sImageColumn,sKey)
  IF LEN(sBlob) = 0 THEN
    BEEP
    '? "zero length blob",,FUNCNAME$
    FUNCTION = 98
    EXIT FUNCTION
  END IF

  sTempFile = FORMAT$(TIMER) + ".tmp"
  result = slPutFileLocal(sTempFile,sBlob)  '6/11/17 wrap in threadsafe transaction

  FUNCTION = result
  IF result THEN
    ? "slPutError" + STR$(result),,FUNCNAME$
    EXIT FUNCTION
  END IF

  hpix = dpAddGraphic(ihandle,sTempFile+$NUL)
  KILL sTempFile
  IF hpix THEN
   dpDrawGraphic ihandle, hpix,x,y,x2,y2 'these values should be passed
  ELSE
   ? "Error getting graphic " + sTempFile,%MB_SYSTEMMODAL,FUNCNAME$
  END IF

END FUNCTION
'-------------------------------------------------------------------------------------------------
SUB SwitchLocal THREADSAFE

 IF CurrentMode = 0 THEN EXIT SUB 'aleady in local mode
 IF %TestMode THEN ? FUNCNAME$
 slPushDatabase
 slSetProcessMods "L0"
 currentMode = 0

END SUB
'-------------------------------------------------------------------------------------------------
SUB SwitchRemote THREADSAFE

 IF CurrentMode = %ClientServerFlag THEN EXIT SUB 'already in remote mode
 IF %TestMode THEN ? FUNCNAME$
 slPopDatabase
 slSetProcessMods "L1"
 CurrentMode = %ClientServerFlag

END SUB
4
You've got Questions? We've got Answers! / Re: slSetRelNamedLocks
« Last post by Fredrick Ughimi on June 17, 2017, 01:11:09 PM »
Hello Fim,

>>I will only have a ReturnCode -11, no display.

As per the document %SQLitening_LockTimeout  = -11 - Timeout occurred trying to lock an object or database

Check Frank W. Kelley comments here:

http://sqlitening.com/support/index.php?topic=9391.msg24774#msg24774
5
You've got Questions? We've got Answers! / slSetRelNamedLocks
« Last post by Fim on June 17, 2017, 08:13:48 AM »
How to avoid slSetRelNamedLock displaying an error message?
I will only have a ReturnCode -11, no display.
Code: [Select]
    SlSetProcessMods ("E0")
    SVAR = slSetRelNamedLocks("+" + PA_NR_X)
    MSGBOX "SVAR=" + STR$(SVAR)
6
>>Working on allowing pathed files from client.

Oh ok.
7
You've got Questions? We've got Answers! / Re: Embed Image Using SQLitening & DDOC
« Last post by cj on June 13, 2017, 08:52:36 AM »
Working on allowing pathed files from client.
8
Great! Thanks CJ.

Been distracted with other part of the application.
9
slAddGraphic(iHandle,hpix,sKey,x,y,x2,y2)    'puts the image on the page and returns the hpix handle
if same image is needed more than once, call DrawGraphic ihandle, hpix,x,y,x2,y2 with the hpix handle

'6/11/17
Wrapped slGetFile and slPutFile into threadsafe transactions to avoid multiple writers to temp file.
Removed unused zFileName code in slAddGraphic function.
'-------------------------------------------------------------------------------------------------
#COMPILE EXE
#DIM ALL
$TempFile  = "temp.dat"
#INCLUDE "ddoc_p32.inc" 'requires ddoc32.dll and ddoc_jpg.dll
#INCLUDE "\sql\bin\sqlitening.inc"
'-------------------------------------------------------------------------------------------------
FUNCTION PBMAIN () AS LONG 'ddocsample3.bas
 LOCAL sImageTable     AS STRING
 LOCAL sKeyColumnName  AS STRING
 LOCAL sBlobColumnName AS STRING
 sImageTable     = "ImageTable"
 sKeyColumnName  = "key"
 sBlobColumnName = "picture"

 slOpen "Sample.db3","C"
 slexe "create Table if not exists " + sImageTable + "(key UNIQUE,picture)"
 IF addimage("ImageTable","\pbwin10\samples\ddt\graphic\digital\digits.bmp",FORMAT$(TIMER))       THEN EXIT FUNCTION
 IF addImage("ImageTable","\pbwin10\samples\ddt\graphic\powerbasic pong\backg.bmp",FORMAT$(TIMER)) THEN EXIT FUNCTION
 Test "select key from ImageTable","ImageTable","picture"
END FUNCTION
'-------------------------------------------------------------------------------------------------
SUB test(sql AS STRING,sImageTable AS STRING,sImageColumn AS STRING)
 LOCAL x,y,x2,y2 AS SINGLE
 LOCAL PrintPreview,DefaultZoom,TheBin,EndCode,iHandle,counter,hpix AS LONG
 LOCAL docTitle   AS ASCIIZ * 66
 LOCAL outputfile AS ASCIIZ * 66
 LOCAL skey AS STRING
 LOCAL sKeyArray() AS STRING

 PrintPreview = 1
 DefaultZoom = %DDOC_ZOOM75
 TheBin = %DDOC_Bin_Auto
 IF PrintPreview THEN
  endCode = %DDOC_END_VIEW + %DDOC_END_DELETE
 ELSE
  endCode = %DDOC_END_PRINT + %DDOC_END_DELETE
  DefaultZoom+= %DDOC_VIEWBUILD 'so no dialog will appear
 END IF
 ihandle = dpStartDoc(0,DocTitle,outputfile,%DDOC_INCH,%DDOC_PAPER_LETTER,%DDOC_SYSTEM_DEFAULT,TheBin,DefaultZoom + %DDOC_VIEWBUILD)

 'Your SQL here
 slSelAry sql,sKeyArray(),"Q9 E0"
 IF slGetErrorNumber THEN ? slGetError,%MB_ICONERROR OR %MB_SYSTEMMODAL,"No images will print"

 FOR counter = 1 TO UBOUND(sKeyarray)
  skey = skeyArray(counter)
  x =  0
  y  = 0    'upper left row
  x2 = 3    'low right column
  y2 = 5    'low right row
  slAddGraphic(iHandle,hpix,sImageTable,sImageColumn,sKey,x,y,x2,y2)

  IF counter<> UBOUND(sKeyArray)THEN
   dpNewPage iHandle,  %ddoc_PAPER_A4, %DDOC_PORTRAIT, %DDOC_BIN_AUTO
  END IF
 NEXT
 dpEndDoc iHandle, EndCode
END SUB
'-------------------------------------------------------------------------------------------------
FUNCTION slPutImageToTable(sImageTable AS STRING,sKey AS STRING,sBlob AS STRING) AS LONG
 slExeBind "Replace into "+sImageTable + " values(?,?)", slBuildBindDat(sKey,"T") +slBuildBindDat(sBlob)
 IF slGetChangeCount <> 1 THEN ? "Image key " + sKey,,"slPutImage Error":FUNCTION = 1
END FUNCTION
'-------------------------------------------------------------------------------------------------
FUNCTION slGetImageFromTable(sImageTable AS STRING,sImageColumn AS STRING, sKey AS STRING) AS STRING
 LOCAL sBlob AS STRING
 IF slsel("select " + sImageColumn + " from " + sImageTable + " where key ='" + sKey + "'",0,"E0") = 0 THEN
  slGetRow
  FUNCTION = slf(1)
 END IF
END FUNCTION

FUNCTION slPutFileHelper(sBlob AS STRING) THREADSAFE AS LONG
 slexe "begin exclusive"
 slPutFile $TempFile,sBlob,"C E0"     ' Truncate is default C create if not exist
 FUNCTION = slGetErrorNumber
 slexe "end"
END FUNCTION

FUNCTION slGetFileHelper(sFile AS STRING,sBlob AS STRING) THREADSAFE AS LONG
 slexe "begin exclusive"
 slGetFile sFile,sBlob,"C E0"     ' Truncate is default C create if not exist
 FUNCTION = slGetErrorNumber
 slexe "end"
END FUNCTION

'-------------------------------------------------------------------------------------------------
FUNCTION slAddGraphic(iHandle AS LONG,hPix AS LONG,sImageTable AS STRING,sImageColumn AS STRING,sKey AS STRING, _
                      x AS SINGLE,y AS SINGLE,x2 AS SINGLE,y2 AS SINGLE) AS LONG
  LOCAL sBlob AS STRING
  sBlob = slGetImageFromTable(sImageTable,sImageColumn,sKey)
  IF LEN(sBlob) = 0 THEN EXIT FUNCTION
  IF slPutFileHelper(sBlob) THEN  '6/11/17 wrap in threadsafe transaction
    FUNCTION = slGetErrorNumber
    EXIT FUNCTION
  END IF
  hpix = dpAddGraphic(ihandle,$TempFile)
  IF hpix THEN
   dpDrawGraphic ihandle, hpix,x,y,x2,y2 'these values should be passed
  ELSE
   ? "Error getting graphic " + $TempFile,,FUNCNAME$
  END IF
END FUNCTION
'-------------------------------------------------------------------------------------------------
FUNCTION AddImage(sTable AS STRING,sFile AS STRING, sKey AS STRING) AS LONG
 LOCAL sBlob AS STRING
 IF slGetFileHelper(sFile,sBlob) THEN    '6/11/17 wrap in threadsafe transaction
  FUNCTION = slGetErrorNumber
  ? slGetError + $CR + sFile,,FUNCNAME$
  EXIT FUNCTION
 END IF
 IF slPutImageToTable(sTable,sKey,sBlob) THEN
  FUNCTION = 1
  ? "Unable to add image key" + sKey,,FUNCNAME$
 END IF
END FUNCTION
10
I am running it on a multiuser environment.
Pages: [1] 2 3 ... 10