Multiple DatabaseUpdate inside DatabaseQuery issue

Just starting out? Need help? Post your questions and find answers here.
User avatar
Fangbeast
PureBasic Protozoa
PureBasic Protozoa
Posts: 4747
Joined: Fri Apr 25, 2003 3:08 pm
Location: Not Sydney!!! (Bad water, no goats)

Multiple DatabaseUpdate inside DatabaseQuery issue

Post by Fangbeast »

Should have gone to bed. I have at least 3 DatabaseUpdate statements inside a DatabaseQuery and I think I broke the loop somewhere and cannot see it (So very tired) as only one record is processed.

Can anyone do me a favour and see if they can spot where I might have broken the loop?

Code: Select all

; Convert the database selected by the user, import all the records

Procedure ConvertDatabaseNow()
  ; 
  NewNumberOfItems.i = #False
  ; 
  If  Program\AttachedDatabase  <>  #Empty$
    ; 
    SetInfoBarArea("Headings", "Info", "Starting to convert and import the attached database, please wait a while", #PB_Compiler_Procedure)
    ; 
    AttachedDatabaseQuery.s                   + 
    "SELECT * "                               + 
    "FROM RemoteDatabase.Keeper "             + 
    "AS m "                                   + 
    "LEFT JOIN RemoteDatabase.Attachments "   + 
    "AS n "                                   + 
    "ON m.Record = n.Record"                   
    ; 
    If DatabaseQuery(Program\DatabaseHandle, AttachedDatabaseQuery.s) <>  #DatabaseQueryFail
      ; 
      While NextDatabaseRow(Program\DatabaseHandle)
        ; 
        MyInfo\Title          = KillQuote(GetDatabaseString(Program\DatabaseHandle,   0))                 : Debug MyInfo\Title
        MyInfo\Information    = KillQuote(GetDatabaseString(Program\DatabaseHandle,   1))                 : Debug MyInfo\Information
        MyInfo\Category       = KillQuote(GetDatabaseString(Program\DatabaseHandle,   2))                 ;
        MyInfo\Archived       =           GetDatabaseString(Program\DatabaseHandle,   3)                  ;
        MyInfo\Favourite      =           GetDatabaseString(Program\DatabaseHandle,   4)                  ;
        MyInfo\Locked         =           GetDatabaseString(Program\DatabaseHandle,   5)                  ;
        MyInfo\Deleted        =           GetDatabaseString(Program\DatabaseHandle,   6)                  ;
        MyInfo\Updated        =           GetDatabaseString(Program\DatabaseHandle,   7)                  ;
        MyInfo\Owner          = KillQuote(GetDatabaseString(Program\DatabaseHandle,   8))                 ;
        MyInfo\Attachments    =           GetDatabaseString(Program\DatabaseHandle,   9)                  ;
        MyInfo\Recordid       =           GetDatabaseString(Program\DatabaseHandle,  10)                  ;
        Attachmentid.s        =           GetDatabaseString(Program\DatabaseHandle,  11)                  ; This is the Attachments autoincrement field
        AttachmentLength.i    =          DatabaseColumnSize(Program\DatabaseHandle,  12)                  ; This is the attachment blob data
        AttachmentRecordid.s  =           GetDatabaseString(Program\DatabaseHandle,  13)                  ; The linked record id of the attachment
        ; Workaround to strip rtf data from the old Keeper information field
        SetGadgetText(#Gadget_Convert_eStripRtfData, MyInfo\Information)
        MyInfo\Information  = GetGadgetText(#Gadget_Convert_eStripRtfData)
        ; 
        MyInfoInsertString.s                          + 
        "INSERT INTO MyInfo("                         + 
        "Title, "                                     + 
        "Information, "                               + 
        "Category, "                                  + 
        "Archived, "                                  + 
        "Favourite, "                                 + 
        "Locked, "                                    + 
        "Deleted, "                                   + 
        "Updated, "                                   + 
        "Owner, "                                     + 
        "Attachments) "                               + 
        "VALUES("                                     + 
        "'"   +   RepQuote(MyInfo\Title)       + "'"  + 
        ", '" +   RepQuote(MyInfo\Information) + "'"  + 
        ", '" +   RepQuote(MyInfo\Category)    + "'"  + 
        ", '" +   RepQuote(MyInfo\Archived)    + "'"  + 
        ", '" +   RepQuote(MyInfo\Favourite)   + "'"  + 
        ", '" +   RepQuote(MyInfo\Locked)      + "'"  + 
        ", '" +   RepQuote(MyInfo\Deleted)     + "'"  + 
        ", '" +   RepQuote(MyInfo\Updated)     + "'"  + 
        ", '" +   RepQuote(MyInfo\Owner)       + "'"  + 
        ", '" +   "0"                          + "'"  + 
        ")"
        ; 
        If DatabaseUpdate(Program\DatabaseHandle, MyInfoInsertString.s)  <> #DatabaseUpdateFail
          ; 
          NewRecordid.s = DatabaseLastInsertRowId()
          ; 
          If NewRecordId.s <> #Empty$
            ; 
            AddGadgetItem(#Gadget_Convert_Titles, #AtTheEndOfTheList, KillQuote(MyInfo\Title) + #LF$  + "Added"  + #LF$  + NewRecordId.s)
            ; 
            NewNumberOfItems.i  + 1
            ; 
            LastLine(#Gadget_Convert_Titles, NewNumberOfItems.i - 1)
            ; Get the blob from the database and save it to MyInfo Attachments table relinked
            If AttachmentLength.i <> #NoDataFound
              *AttachmentBlobBuffer   =           AllocateMemory(AttachmentLength.i)
              BlobResult.i            =           GetDatabaseBlob(Program\DatabaseHandle, 12, *AttachmentBlobBuffer, AttachmentLength.i)
              If BlobResult.i <>  #NoBlobFound
                ; Write this blob to the MyInfo database attachments table
                SetDatabaseBlob(Program\DatabaseHandle, 0, *AttachmentBlobBuffer, AttachmentLength.i)
                AttachmentUpdate.s          + 
                "INSERT INTO Attachments (" + 
                "Attachmentid, "            + 
                "Attachment, "              + 
                "Filename) "                + 
                "VALUES('"                  + 
                NewRecordid.s               + "', " + 
                "? "                        + ", '" +
                #Empty$                     + "'  " + 
                ")"
                If DatabaseUpdate(Program\DatabaseHandle, AttachmentUpdate.s) <> #DatabaseUpdateFail
                  SetInfoBarArea("Headings", "Info", "Saved an attachment for "   + KillQuote(MyInfo\Title), #PB_Compiler_Procedure)
                Else
                  SetInfoBarArea("Headings", "Error", "No attachment saved for "  + KillQuote(MyInfo\Title), #PB_Compiler_Procedure)
                EndIf
              Else
                SetInfoBarArea("Headings", "Info", "No attachment found for "     + KillQuote(MyInfo\Title), #PB_Compiler_Procedure)
              EndIf  
            Else
              SetInfoBarArea("Headings", "Error", "Could not retrieve the attachment from the old Keeper database ", #PB_Compiler_Procedure)
            EndIf
            ; Update the category table now
            NewCategoryInsert.s         + 
            "INSERT INTO Categories("   + 
            "Category, "                + 
            "Itemcount, "               + 
            "Iconname) "                + 
            "VALUES("                   + 
            "'"                         + 
            RepQuote(MyInfo\Category)   + 
            "', '"                      + 
            "0"                         + 
            "', '"                      + 
            #Empty$                     + 
            "')"
            If DatabaseUpdate(Program\DatabaseHandle, NewCategoryInsert.s)  <> #DatabaseUpdateFail
              UpdateCategoryItemCount(MyInfo\Category)
            Else
              SetInfoBarArea("Headings", "Error", "Database table 'Categories' failed to be updated " + DatabaseError(), #PB_Compiler_Procedure)
            EndIf
            ; Update the Owners table now
            NewOwnerInsert.s            + 
            "INSERT INTO Owners("       + 
            "Owner, "                   + 
            "Iconname, "                + 
            "Itemcount) "               + 
            "VALUES('"                  + 
            RepQuote(MyInfo\Owner)      + 
            "', "                       + 
            "'"                         + 
            #Empty$                     + 
            "', "                       + 
            "'0')"
            If DatabaseUpdate(Program\DatabaseHandle, NewOwnerInsert.s)  <> #DatabaseUpdateFail
              UpdateOwnerItemCount(MyInfo\Owner)
            Else
              SetInfoBarArea("Headings", "Error", "Database table 'Owners' failed to be updated " + DatabaseError(), #PB_Compiler_Procedure)
            EndIf
            ; 
            If Toggle\MessageSave = #True
              MessageRequesterEBS("New Item", "New item: " + KillQuote(MyInfo\Title)  + " has been saved to the database", #MB_ICONINFORMATION | #PB_MessageRequester_Ok)
              ;MessageRequester("New Item", "New item: " + KillQuote(MyInfo\Title)  + " has been saved to the database", #PB_MessageRequester_Ok)
            EndIf
            ; 
          Else
            SetInfoBarArea("Headings",  "Error",  "No record number created " + DatabaseError(), #PB_Compiler_Procedure)
            AddGadgetItem(#Gadget_Convert_Titles, #AtTheEndOfTheList, KillQuote(MyInfo\Title) + #LF$  + "Skipped"  + #LF$  + NewRecordId.s)
            NewNumberOfItems.i  + 1
            LastLine(#Gadget_Convert_Titles, NewNumberOfItems.i - 1)
          EndIf
          ; 
        Else
          SetInfoBarArea("Headings", "Error", "Database table failed to be updated " + DatabaseError(), #PB_Compiler_Procedure)
        EndIf
        ; Clean out all the variables just to be certain
        ClearStructure(@Myinfo, MyinfoData)
        AttachedDatabaseQuery.s   = #Empty$
        MyInfoInsertString.s      = #Empty$
        AttachmentUpdate.s        = #Empty$
        NewCategoryInsert.s       = #Empty$
        NewOwnerInsert.s          = #Empty$
        Attachmentid.s            = #Empty$
        AttachmentLength.i        = #False
        AttachmentRecordid.s      = #Empty$
        NewRecordid.s             = #Empty$
        BlobResult.i              = #False
        SetGadgetText(#Gadget_Convert_eStripRtfData, #Empty$)
        If *AttachmentBlobBuffer
          FreeMemory(*AttachmentBlobBuffer)
        EndIf
        ; 
      Wend
      ; 
      FinishDatabaseQuery(Program\DatabaseHandle)
      ; 
    Else
      SetInfoBarArea("Headings", "Error", "The database query failed or was empty:  " + DatabaseError(), #PB_Compiler_Procedure)
      MessageRequesterEBS("Database conversion", "The database failed to be converted"  + #CRLF$  + #CRLF$  + DatabaseError(), #MB_ICONINFORMATION | #PB_MessageRequester_Ok)
    EndIf
    ; 
  Else
    SetInfoBarArea("Headings", "Error", "There is currently no attached database selected for conversion", #PB_Compiler_Procedure)
    MessageRequesterEBS("No database attached", "There is currently no attached database selected for conversion", #MB_ICONINFORMATION | #PB_MessageRequester_Ok)
  EndIf
  ; 
EndProcedure
Amateur Radio, D-STAR/VK3HAF
infratec
Always Here
Always Here
Posts: 6817
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: Multiple DatabaseUpdate inside DatabaseQuery issue

Post by infratec »

Hi,

I think you made a query inside of a query:

Code: Select all

 NewRecordid.s = DatabaseLastInsertRowId()
which breaks the loop.
You should first create a list with the results and then make the updates.
User avatar
Fangbeast
PureBasic Protozoa
PureBasic Protozoa
Posts: 4747
Joined: Fri Apr 25, 2003 3:08 pm
Location: Not Sydney!!! (Bad water, no goats)

Re: Multiple DatabaseUpdate inside DatabaseQuery issue

Post by Fangbeast »

infratec wrote:Hi,

I think you made a query inside of a query:

Code: Select all

 NewRecordid.s = DatabaseLastInsertRowId()
which breaks the loop.
You should first create a list with the results and then make the updates.
Damn, I knew I was tired. It was 11:30 last night before I fell out of the chair and I was trying to simplify code. Thanks Bernd.
Amateur Radio, D-STAR/VK3HAF
User avatar
Fangbeast
PureBasic Protozoa
PureBasic Protozoa
Posts: 4747
Joined: Fri Apr 25, 2003 3:08 pm
Location: Not Sydney!!! (Bad water, no goats)

Re: Multiple DatabaseUpdate inside DatabaseQuery issue

Post by Fangbeast »

Thanks Bernd. Got the template code for the list all done, can now test the conversion. It's going to be a hot few days and my eyesight is worse than ever so may have to wait but I tested it in SqLiteExpertPersonal for logic.
Amateur Radio, D-STAR/VK3HAF
User avatar
Blue
Addict
Addict
Posts: 864
Joined: Fri Oct 06, 2006 4:41 am
Location: Canada

Re: Multiple DatabaseUpdate inside DatabaseQuery issue

Post by Blue »

Thank you Fangbeast for making me discover SqLiteExpertPersonal.
I had never heard of this tool before you mentioned it.
Now go get some rest. You just earned it.
"That's not a bug..." said the programmer. "it's a feature! "
"Oh! I see..." replied the blind man.
User avatar
Fangbeast
PureBasic Protozoa
PureBasic Protozoa
Posts: 4747
Joined: Fri Apr 25, 2003 3:08 pm
Location: Not Sydney!!! (Bad water, no goats)

Re: Multiple DatabaseUpdate inside DatabaseQuery issue

Post by Fangbeast »

Blue wrote:Thank you Fangbeast for making me discover SqLiteExpertPersonal.
I had never heard of this tool before you mentioned it.
Now go get some rest. You just earned it.
LOL!!! Not the only free (Basic features are free and do the job) but the only one I use now.

I wish I could say I earned a rest but as the temperature has hit 30 here, the compiler is throwing out a bizarre error message that didn't happen the last time I ran it and I haven't changed a thing. So I have no rest.

DatabaseBrowser_Portable is another one. I used to have others but cleared out all my downloads.
Amateur Radio, D-STAR/VK3HAF
User avatar
Fangbeast
PureBasic Protozoa
PureBasic Protozoa
Posts: 4747
Joined: Fri Apr 25, 2003 3:08 pm
Location: Not Sydney!!! (Bad water, no goats)

Re: Multiple DatabaseUpdate inside DatabaseQuery issue

Post by Fangbeast »

Well, finally got the code sorted out. Didn't get it until the temperature dropped back to 25 (From 36!!) and my brain stopped melting.

I am using LockWindowUpdate to prevent the greying out of the listicongadget (but it takes a while to return anyway) as I tried threads and it didn't end well. Maybe someone can suggest how I can use threads properly here for the display part of things.

At any rate, will release an update to the MyInfo )New Keeper replacement) during the week if all goes well. The converter is working and tested here.

Code: Select all

; Convert the database selected by the user, import all the records

Procedure ConvertDatabaseNow()
  
  NewNumberOfItems.i = #False
  
  If  Program\AttachedDatabase  <>  #Empty$
    
    SetGadgetText(#Gadget_Convert_sStatusBar, "Starting to convert and import the attached database, please wait a while")
    
    SetInfoBarArea("Headings", "Info", "Starting to convert and import the attached database, please wait a while", #PB_Compiler_Procedure)
    
    NewList RecordNumberList.s()
    
    RecordSetQuery.s                          + 
    "SELECT Record "                          + 
    "FROM RemoteDatabase.Keeper "
    
    If DatabaseQuery(Program\DatabaseHandle, RecordSetQuery.s) <>  #DatabaseQueryFail
      While NextDatabaseRow(Program\DatabaseHandle)
        AddElement(RecordNumberList.s())
        RecordNumberList.s() = GetDatabaseString(Program\DatabaseHandle, 0)
      Wend
      FinishDatabaseQuery(Program\DatabaseHandle)
    EndIf
    
    RecordSetQuery.s  = #Empty$
    
    If ListSize(RecordNumberList.s())
      
      LockWindowUpdate_(GadgetID(#Gadget_Convert_Titles))
      
      ForEach RecordNumberList.s()
        
        AttachedDatabaseQuery.s                   + 
        "SELECT * "                               + 
        "FROM RemoteDatabase.Keeper "             + 
        "AS m "                                   + 
        "LEFT JOIN RemoteDatabase.Attachments "   + 
        "AS n "                                   + 
        "ON m.Record = n.Record "                 + 
        "WHERE m.Record = '"                      + 
        RecordNumberList.s()                      + 
        "'"
        
        If DatabaseQuery(Program\DatabaseHandle, AttachedDatabaseQuery.s) <>  #DatabaseQueryFail
          
          While NextDatabaseRow(Program\DatabaseHandle)
            
            MyInfo\Title          = KillQuote(GetDatabaseString(Program\DatabaseHandle,   0))                 : ; Debug MyInfo\Title
            MyInfo\Information    = KillQuote(GetDatabaseString(Program\DatabaseHandle,   1))                 : ; Debug MyInfo\Information
            MyInfo\Category       = KillQuote(GetDatabaseString(Program\DatabaseHandle,   2))                 ;
            MyInfo\Archived       =           GetDatabaseString(Program\DatabaseHandle,   3)                  ;
            MyInfo\Favourite      =           GetDatabaseString(Program\DatabaseHandle,   4)                  ;
            MyInfo\Locked         =           GetDatabaseString(Program\DatabaseHandle,   5)                  ;
            MyInfo\Deleted        =           GetDatabaseString(Program\DatabaseHandle,   6)                  ;
            MyInfo\Updated        =           GetDatabaseString(Program\DatabaseHandle,   7)                  ;
            MyInfo\Owner          = KillQuote(GetDatabaseString(Program\DatabaseHandle,   8))                 ;
            MyInfo\Attachments    =           GetDatabaseString(Program\DatabaseHandle,   9)                  ;
            MyInfo\Recordid       =           GetDatabaseString(Program\DatabaseHandle,  10)                  ;
            Attachmentid.s        =           GetDatabaseString(Program\DatabaseHandle,  11)                  ; This is the Attachments autoincrement field
            AttachmentLength.i    =          DatabaseColumnSize(Program\DatabaseHandle,  12)                  ; This is the attachment blob data
            AttachmentRecordid.s  =           GetDatabaseString(Program\DatabaseHandle,  13)                  ; The linked record id of the attachment
            
            ; Workaround to strip rtf data from the old Keeper information field using hidden editor
            
            SetGadgetText(#Gadget_Convert_eStripRtfData, MyInfo\Information)
            MyInfo\Information  = GetGadgetText(#Gadget_Convert_eStripRtfData)
            
          Wend
          
          AttachedDatabaseQuery.s = #Empty$
          
          FinishDatabaseQuery(Program\DatabaseHandle)
          
          ; Now insert the record as new into the Myinfo database
          
          MyInfoInsertString.s                          + 
          "INSERT INTO MyInfo("                         + 
          "Title, "                                     + 
          "Information, "                               + 
          "Category, "                                  + 
          "Archived, "                                  + 
          "Favourite, "                                 + 
          "Locked, "                                    + 
          "Deleted, "                                   + 
          "Updated, "                                   + 
          "Owner, "                                     + 
          "Attachments) "                               + 
          "VALUES("                                     + 
          "'"   +   RepQuote(MyInfo\Title)       + "'"  + 
          ", '" +   RepQuote(MyInfo\Information) + "'"  + 
          ", '" +   RepQuote(MyInfo\Category)    + "'"  + 
          ", '" +   RepQuote(MyInfo\Archived)    + "'"  + 
          ", '" +   RepQuote(MyInfo\Favourite)   + "'"  + 
          ", '" +   RepQuote(MyInfo\Locked)      + "'"  + 
          ", '" +   RepQuote(MyInfo\Deleted)     + "'"  + 
          ", '" +   RepQuote(MyInfo\Updated)     + "'"  + 
          ", '" +   RepQuote(MyInfo\Owner)       + "'"  + 
          ", '" +   "0"                          + "'"  + 
          ")"
          
          If DatabaseUpdate(Program\DatabaseHandle, MyInfoInsertString.s)  <> #DatabaseUpdateFail
            
            NewRecordid.s = DatabaseLastInsertRowId()
            
            If NewRecordId.s <> #Empty$
              
              AddGadgetItem(#Gadget_Convert_Titles, #AtTheEndOfTheList, KillQuote(MyInfo\Title) + #LF$  + "Added"  + #LF$  + NewRecordId.s)
              NewNumberOfItems.i  = CountGadgetItems(#Gadget_Convert_Titles)
              LastLine(#Gadget_Convert_Titles, NewNumberOfItems.i - 1)
              
              ; Get the blob from the database and save it to MyInfo Attachments table relinked
              
              If AttachmentLength.i <> #NoDataFound
                
                *AttachmentBlobBuffer   =           AllocateMemory(AttachmentLength.i)
                
                BlobResult.i            =           GetDatabaseBlob(Program\DatabaseHandle, 12, *AttachmentBlobBuffer, AttachmentLength.i)
                
                If BlobResult.i <>  #NoBlobFound
                  
                  ; Write this blob to the MyInfo database attachments table
                  
                  SetDatabaseBlob(Program\DatabaseHandle, 0, *AttachmentBlobBuffer, AttachmentLength.i)
                  
                  AttachmentUpdate.s          + 
                  "INSERT INTO Attachments (" + 
                  "Attachmentid, "            + 
                  "Attachment, "              + 
                  "Filename) "                + 
                  "VALUES('"                  + 
                  NewRecordid.s               + 
                  "', "                       + 
                  "?, '"                      + 
                  #Empty$                     + 
                  "')"
        
                  If DatabaseUpdate(Program\DatabaseHandle, AttachmentUpdate.s) <> #DatabaseUpdateFail
                    SetInfoBarArea("Headings", "Info", "Saved an attachment for "   + KillQuote(MyInfo\Title), #PB_Compiler_Procedure)
                  Else
                    SetInfoBarArea("Headings", "Error", "No attachment saved for "  + KillQuote(MyInfo\Title), #PB_Compiler_Procedure)
                  EndIf
                  
                  AttachmentUpdate.s  = #Empty$
                  
                Else
                  SetInfoBarArea("Headings", "Error", "No attachment data found in the record for "  + KillQuote(MyInfo\Title), #PB_Compiler_Procedure)
                EndIf
                
              Else
                SetInfoBarArea("Headings", "Info", "No attachment found for "     + KillQuote(MyInfo\Title), #PB_Compiler_Procedure)
              EndIf  

            Else
              SetInfoBarArea("Headings",  "Error",  "No record number created " + DatabaseError(), #PB_Compiler_Procedure)
              AddGadgetItem(#Gadget_Convert_Titles, #AtTheEndOfTheList, KillQuote(MyInfo\Title) + #LF$  + "Skipped"  + #LF$  + NewRecordId.s)
              NewNumberOfItems.i  = CountGadgetItems(#Gadget_Convert_Titles)
              LastLine(#Gadget_Convert_Titles, NewNumberOfItems.i - 1)
            EndIf
            
            MyInfoInsertString.s = #Empty$
            
          Else
            SetInfoBarArea("Headings", "Error", "Database table failed to be updated " + DatabaseError(), #PB_Compiler_Procedure)
          EndIf
          
          ; Update the category table now
          
          If MyInfo\Category  <>  #Empty$ And Len(MyInfo\Category) > = 5  And MyInfo\Category <> #Null$
            
            CategoryInsert.s            + 
            "INSERT INTO Categories("   + 
            "Category, "                + 
            "Itemcount, "               + 
            "Iconname) "                + 
            "VALUES('"                  + 
            RepQuote(MyInfo\Category)   + 
            "', '"                      + 
            "0"                         + 
            "', '"                      + 
            #Empty$                     + 
            "')"
            
            If DatabaseUpdate(Program\DatabaseHandle, CategoryInsert.s)  <> #DatabaseUpdateFail
            Else
              SetInfoBarArea("Headings", "Error", "Database table 'Categories' failed to be updated " + DatabaseError(), #PB_Compiler_Procedure)
            EndIf
            CategoryInsert.s  = #Empty$
            
          Else
            SetInfoBarArea("Headings", "Error", "The category name is too short or empty", #PB_Compiler_Procedure)
          EndIf
          
          ; Update the Owners table now
          
          If MyInfo\Owner  <>  #Empty$ And Len(MyInfo\Owner) > = 5  And MyInfo\Owner <> #Null$
            
            OwnerInsert.s               + 
            "INSERT INTO Owners("       + 
            "Owner, "                   + 
            "Itemcount, "               + 
            "Iconname) "                + 
            "VALUES('"                  + 
            RepQuote(MyInfo\Owner)      + 
            "', '"                      + 
            "0"                         + 
            "', '"                      + 
            #Empty$                     + 
            "')"
          
            If DatabaseUpdate(Program\DatabaseHandle, OwnerInsert.s)  <> #DatabaseUpdateFail
            Else
              SetInfoBarArea("Headings", "Error", "Database table 'Owners' failed to be updated " + DatabaseError(), #PB_Compiler_Procedure)
            EndIf
            
            OwnerInsert.s = #Empty$
          
          Else
            SetInfoBarArea("Headings", "Error", "The category name is too short or empty", #PB_Compiler_Procedure)
          EndIf
          
          If Toggle\MessageSave = #True
            MessageRequesterEBS("New Item", "New item: " + KillQuote(MyInfo\Title)  + " has been saved to the database", #MB_ICONINFORMATION | #PB_MessageRequester_Ok)
            ;MessageRequester("New Item", "New item: " + KillQuote(MyInfo\Title)  + " has been saved to the database", #PB_MessageRequester_Ok)
          EndIf
          
          ; Clean out all the variables
          
          ClearStructure(@Myinfo, MyinfoData)
          
          Attachmentid.s            = #Empty$
          AttachmentLength.i        = #False
          AttachmentRecordid.s      = #Empty$
          NewRecordid.s             = #Empty$
          BlobResult.i              = #False
          
          SetGadgetText(#Gadget_Convert_eStripRtfData, #Empty$)
          
          If *AttachmentBlobBuffer
            FreeMemory(*AttachmentBlobBuffer)
          EndIf
          
        Else
          SetInfoBarArea("Headings", "Error", "The database query failed or was empty:  " + DatabaseError(), #PB_Compiler_Procedure)
          MessageRequesterEBS("Database conversion", "The database failed to be converted"  + #CRLF$  + #CRLF$  + DatabaseError(), #MB_ICONINFORMATION | #PB_MessageRequester_Ok)
        EndIf
        
      Next RecordNumberList.s()
      
      LockWindowUpdate_(0)
      
      SetGadgetText(#Gadget_Convert_sStatusBar, "Synchronising categories to MyInfo and setting counters")
      
      OneTimeCategoryUpdate()
      
      SetGadgetText(#Gadget_Convert_sStatusBar, "Synchronising owners to MyInfo and setting counters")
      
      OneTimeOwnerUpdate()
      
      ; CloseMyWindow(#Window_Convert)
      
      LoadCategories()
      
    Else
      SetGadgetText(#Gadget_Convert_sStatusBar, "There were no items in the list to be processed")
      SetInfoBarArea("Headings", "Info", "There were no items in the list to be processed", #PB_Compiler_Procedure)
    EndIf
    
  Else
    SetGadgetText(#Gadget_Convert_sStatusBar, "There is currently no attached database selected for conversion")
    SetInfoBarArea("Headings", "Error", "There is currently no attached database selected for conversion", #PB_Compiler_Procedure)
    MessageRequesterEBS("No database attached", "There is currently no attached database selected for conversion", #MB_ICONINFORMATION | #PB_MessageRequester_Ok)
  EndIf
  
EndProcedure
Amateur Radio, D-STAR/VK3HAF
User avatar
skywalk
Addict
Addict
Posts: 3972
Joined: Wed Dec 23, 2009 10:14 pm
Location: Boston, MA

Re: Multiple DatabaseUpdate inside DatabaseQuery issue

Post by skywalk »

Fangbeast wrote:I am using LockWindowUpdate to prevent the greying out of the listicongadget (but it takes a while to return anyway) as I tried threads and it didn't end well. Maybe someone can suggest how I can use threads properly here for the display part of things.
Ok, mk-soft made several excellent examples in the forum. Key steps are:
BindEvent(#EVWW_THR_SIGNAL_FROM_YOUR_THREAD, @YOUR_GUI_UPDATE_PROCEDURE())
Your thread procedure "talks" to the GUI with:
PostEvent(#EVWW_THR_SIGNAL_FROM_YOUR_THREAD, YOURWINDOWnumber, *YOUR_THR_STRUCT, *YOUR_THR_STRUCT\now_state)
WaitSemaphore(*YOUR_THR_STRUCT\signal) ; Pause self until gui responds.

Your GUI "listens" and responds within YOUR_GUI_UPDATE_PROCEDURE() which then tells the thread to continue or stop or whatever.
SignalSemaphore(YOUR_THR_STRUCT\signal)

Do not use PauseThread() or ResumeThread() commands. I found them to skip events or have small time delays.
The nice thing about standards is there are so many to choose from. ~ Andrew Tanenbaum
Marc56us
Addict
Addict
Posts: 1477
Joined: Sat Feb 08, 2014 3:26 pm

Re: Multiple DatabaseUpdate inside DatabaseQuery issue

Post by Marc56us »

Maybe someone can suggest how I can use threads properly here for the display part of things.
:!: The only thing to check with a thread is that several parts of programs must not write to the same gadget or variable at the same time. It's easy to manage, just be methodical.

A horrible example I quickly realized that shows how a thread can interact with the main program in secure way.
Here, the thread adds a line every 3 seconds in the main window.
When start thread, the ListView is locked so that the user does not modify it.
The whole interface continues to work since the clock rotates every second while the thread pauses for 3 seconds.
The user can follow what is happening in the background and is prevented from manipulating certain objects.
The gadget (List) is disabled for him, but continues to receive the data sent by the thread.
Unlike a one-level program, it can use the rest of the functions (including moving the window) and has no waiting cursor.
When you stop the thread, you release the gadget.
:arrow: Yes, if the program did more complicated things, it would be better to use a flag rather than a KillThread

Code: Select all

EnableExplicit

Enumeration 
    #Win    
    #Btn_Quit
    #Btn_Start_Thread
    #Btn_Stop_Thread
    #Lst
    #Sec
EndEnumeration

Define ID_Thread
Global i

SetGadgetFont(#PB_Default, FontID(LoadFont(#PB_Any, "Consolas", 10)))

OpenWindow    (#Win, 0, 0, 500, 300, "", $CC0001)
AddWindowTimer(#Win, #Sec, 1000)
ListViewGadget(#Lst, 5, 5, WindowWidth(#Win) -  10, WindowHeight(#Win) - 40)
ButtonGadget  (#Btn_Quit,  WindowWidth(#Win) -  85, WindowHeight(#Win) - 30, 80, 25, "Quit")
ButtonGadget  (#Btn_Start_Thread, WindowWidth(#Win) - 255, WindowHeight(#Win) - 30, 80, 25, "Start")
ButtonGadget  (#Btn_Stop_Thread,  WindowWidth(#Win) - 170, WindowHeight(#Win) - 30, 80, 25, "Stop")


Procedure Start_Thread(*Value)
    DisableGadget(#Lst, 1) ; Disable Listview: User can only see
    Repeat  
        i + 1
        AddGadgetItem(#Lst, -1,  Str(i))
        Delay(3000) ; Yes, delay, but rest of program continue (see timer)
    ForEver
EndProcedure


Repeat
    SetWindowTitle(#Win, FormatDate("%hh:%ii:%ss", Date()))
    Select WaitWindowEvent()
        Case #PB_Event_CloseWindow
            Break 
            
        Case #PB_Event_Gadget
            Select EventGadget()
                Case #Btn_Start_Thread
                    If Not IsThread(ID_Thread)
                        ID_Thread = CreateThread(@Start_Thread(), 1)
                    EndIf
                    
                Case #Btn_Stop_Thread
                    KillThread(ID_Thread) ; Horrible! but yes I control ;-)
                    DisableGadget(#Lst, 0) ; Enable Listview
                    
                Case #Btn_Quit
                    Break   
                    
            EndSelect
    EndSelect
ForEver

End
"Think simple"

:wink:

PS
"'" + RepQuote(MyInfo\Title) + "'" + ... '"'"'" + "''"+ ''"' '"' '"' '"' ...

:) :arrow: SetDatabaseString()
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Multiple DatabaseUpdate inside DatabaseQuery issue

Post by mk-soft »

Sometimes the GUI don't like changes from threads. Better is to use PostEvent for update gadgets.

For this a have a module ThreadToGUI.

Link: viewtopic.php?f=12&t=66180

Example

Code: Select all

;-TOP

; Example ThreadToGUI
; Link: https://www.purebasic.fr/english/viewtopic.php?f=12&t=66180

IncludeFile "Modul_ThreadToGUI.pb"

Enumeration #PB_Event_FirstCustomValue
  #My_Event_ThreadToGUI
EndEnumeration

Structure udtThreadData
  ThreadId.i
  Cancel.i
  ; Data
  GadgetList.i
EndStructure

Procedure thFillList(*data.udtThreadData)
  Protected text.s, count
  
  UseModule ThreadToGUI
  
  DoSetGadgetText(1, "Stop Query")
  DoStatusBarText(0, 0, "Thread 1 running...")
  DoDisableGadget(*data\GadgetList, 1)
  DoClearGadgetItems(*data\GadgetList)
  For count = 1 To 10000
    text = FormatDate("%HH:%II:%SS - Number ", Date()) + Str(count)
    DoAddGadgetItem(*data\GadgetList, -1, text)
    ;Delay(1)
    If *data\Cancel
      Break
    EndIf
    If count % 100 = 0
      Delay(100)
    EndIf
  Next
  DoDisableGadget(*data\GadgetList, 0)
  DoStatusBarText(0, 0, "Thread 1 finished.")
  DoSetGadgetText(1, "Start Fill")
  
  *data\Cancel = 0
  
  UnuseModule ThreadToGUI
  
EndProcedure

Procedure Main()
  Protected event, thread1.udtThreadData
  
  thread1\GadgetList = 0
  
  If OpenWindow(1, #PB_Ignore, #PB_Ignore, 800, 560, "Thread To GUI Example", #PB_Window_SystemMenu)
    CreateStatusBar(0, WindowID(1))
    AddStatusBarField(200)
    StatusBarText(0, 0, "Thread 1")
    AddStatusBarField(200)
    AddStatusBarField(#PB_Ignore)
    
    ListViewGadget(0, 0, 0, 800, 500)
    ButtonGadget(1, 10, 510, 120, 24, "Start Query")
    StringGadget(3, 710, 510, 80, 24, "State", #PB_String_ReadOnly)
    
    ThreadToGUI::BindEventGUI(#My_Event_ThreadToGUI)
    
    Repeat
      event = WaitWindowEvent(10)
      Select event
        Case #PB_Event_CloseWindow
          
          If IsThread(thread1\ThreadId)
            MessageRequester("Info", "Threads running...")
          Else
            Break
          EndIf
          
        Case #PB_Event_Gadget
          Select EventGadget()
            Case 1
              If Not IsThread(thread1\ThreadId)
                thread1\ThreadId = CreateThread(@thFillList(), thread1)
              Else
                thread1\Cancel = 1
              EndIf
              
          EndSelect
          
      EndSelect
      
    ForEver
    
  EndIf
  
EndProcedure : Main()
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
Fangbeast
PureBasic Protozoa
PureBasic Protozoa
Posts: 4747
Joined: Fri Apr 25, 2003 3:08 pm
Location: Not Sydney!!! (Bad water, no goats)

Re: Multiple DatabaseUpdate inside DatabaseQuery issue

Post by Fangbeast »

Think simple
Oi!! I am simple!! "Wot you talking about there Willis??" (Shaddap srod ya varmint)

The last time I tried someone's thread code, strange things happened and data went other than where it had to (LOL!!)
SetDatabaseString()
Seen it somewhere, didn't know what it was for so left it. Need to find an example in the forum before I try it.
Amateur Radio, D-STAR/VK3HAF
User avatar
Fangbeast
PureBasic Protozoa
PureBasic Protozoa
Posts: 4747
Joined: Fri Apr 25, 2003 3:08 pm
Location: Not Sydney!!! (Bad water, no goats)

Re: Multiple DatabaseUpdate inside DatabaseQuery issue

Post by Fangbeast »

Your code scares me mk-soft and I don't understand it. Will take me a long time before I am confident enough to use your way of doing things.
Amateur Radio, D-STAR/VK3HAF
User avatar
skywalk
Addict
Addict
Posts: 3972
Joined: Wed Dec 23, 2009 10:14 pm
Location: Boston, MA

Re: Multiple DatabaseUpdate inside DatabaseQuery issue

Post by skywalk »

PB and threading can be straightforward, provided you respect the GUI main event loop as the main thread.
Just make a simple app and debug it using mk-soft's guide or search for similar from infratec,ts-soft.
I tried to explain it in a few sentences. :)
The nice thing about standards is there are so many to choose from. ~ Andrew Tanenbaum
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Multiple DatabaseUpdate inside DatabaseQuery issue

Post by mk-soft »

Fangbeast wrote:Your code scares me mk-soft and I don't understand it. Will take me a long time before I am confident enough to use your way of doing things.
Don't panic... 8)

You just have to understand something about how Purebasic deals with events.
All events like pressing a button or resizing windows, etc. run into an internal event buffer of Purebasic.
These are then passed to the user program with the call of WaitWindowEvent(). This must always be called in a loop in the main program (MainThread).

Now with PostEvent(...) you can add your own event to this internal event buffer from a thread. These arrive then also in the main loop of the main program (MainThread) with the call of WaitWindowEvent().

You can bind events to your own procedure with BindEvent().
Now you also have to know, that event connected with BindEvent() is processed with the call of WaitWindowEvent() and therefore also processed in the main program (MainThread).

What does ThreadToGUI.
With the call of Do[PG-function] a memory is requested and filled with the data of the function. Then the function PostEvent() with the pointers to the data is added to the internal event buffer.
When WaitWindowEvent() is called, the data is resolved again and called with the correct gadget function.

This is done by a procedure associated with BindEvent.
This procedure decides if the memory will be freed or if the data will be replenished. When filling a list no data is returned. Thus the thread does not have to wait and the memory is released in the MainThread again.
If data is expected, the thread passes a semaphore in the data and waits for the signal, which is then set in the MainThread.






Translated with http://www.DeepL.com/Translator
Last edited by mk-soft on Tue Jan 15, 2019 12:54 am, edited 1 time in total.
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
Fangbeast
PureBasic Protozoa
PureBasic Protozoa
Posts: 4747
Joined: Fri Apr 25, 2003 3:08 pm
Location: Not Sydney!!! (Bad water, no goats)

Re: Multiple DatabaseUpdate inside DatabaseQuery issue

Post by Fangbeast »

Don't panic... 8)
But I like panicking!! Have to justify my existence somehow :):):)

If we ever get out of 46 degree days, I will look at your code.

Right now though, the synapses are melting!
Amateur Radio, D-STAR/VK3HAF
Post Reply