Pastebin: 【BASIC!】メモデータベース・ソースプログラム

Format

Plain text

Post date

2014-02-14 17:52

Publication Period

Unlimited

 REM Start of BASIC! Program
 popup "メモデータベースを起動します。",0,0,1
 console.title "メモデータベース"
 pause 4000
 
   input "タブレットモード（キーボードなし）で起動しますか？(y/n)",tab$,"y"
   if tab$="y" then
      print "タブレットモードで起動します。"
      jjj=1 
   else
      print "キーボード有りモードで起動します。"
   endif 
 
 
 
 gosub tbopn
 gosub menux
 
 gosub cldb
 popup "メモデータベースを終了します。",0,0,1
 pause 5000
 
 exit
 
 
 
 !------- menu routine ----- 
 menux:
   if vv$<>"9" then
     print "メモデータベース>>1-検索 2-変更 3-削除 4-全データ一覧 5-新規 6-件名一覧 7-メモ新規 9-終了 c-クリア a-lunch e-閲覧 f-掲載済 x-初期化"
     if tab$="y" then
        print "☆タブレットモードではバックボタンを押してから操作を選択☆"
     else
     endif
   else
   endif
   ink=0
   do
    if vv$<>"9" then
       if tab$="y" then
 !        popup  "wait...",300,-150,1
 !        pause 5000
         if jjj=1 then
           input "選択=> 1-検索 2-変更 3-削除 4-全一覧 5-新規 6-件一覧 7-メ新 9-終 c-ク a-ラ e-閲 f-済 x-初期",vv$
           jjj=0
         else
           vv$=""
         endif
       else  
         inkey$ vv$
       endif
    endif 
    if vv$="1" then 
       gosub kensak
       ink=1
    endif 
    if vv$="2" then 
       gosub henkou
       ink=1
    endif 
    if vv$="3" then 
       gosub sakujo
       ink=1
    endif 
    if vv$="4" then 
       gosub pall
       ink=1
    endif 
 
    if vv$="5" then 
       gosub intbl
       ink=1
    endif 
    if vv$="6" then 
       gosub pken
       ink=1
    endif 
    if vv$="7" then 
       gosub mintbl
       ink=1
    endif 
    if vv$="9" then 
       ink=1
    endif 
    if vv$="a" then 
       gosub luch
       ink=1
    endif 
    if vv$="e" then 
       gosub eturan
       ink=1
    endif 
    if vv$="f" then 
       gosub henkof
       ink=1
    endif 
    if vv$="c" then
       cls
       print "メモデータベース>>1-検索 2-変更 3-削除 4-全データ一覧 5-新規 6-件名一覧 7-メモ新規 9-終了 c-クリア a-lunch e-閲覧 f-掲載済 x-初期化" 
       if tab$="y" then
          print "☆タブレットモードではバックボタンを押してから操作を選択☆"
       else
       endif
    endif 
    if vv$="x" then 
       gosub syoki
       ink=1
    endif 
   until ink 
 return
 
 !------- TBL Initialize (NEW) routine ----- 
 syoki:
 
 input "本当に初期化しますか？すべてのデータが削除されます。",syo$
 if syo$="y" then 
 else
    return
 endif 
 
 
 SQL.CLOSE DB_Ptr
 
 SQL.OPEN DB_Ptr, dbname$
 
 tbname$ = "memo001"
 c1$ = "kenmei"
 c2$ = "updymd"
 c3$ = "keisaif"
 c4$ = "kanren"
 c5$ = "naiyou"
 
 SQL.DROP_TABLE DB_Ptr, tbname$
 
 SQL.NEW_TABLE DB_Ptr, tbname$, c1$, c2$, c3$, c4$,c5$
 
 gosub menux
 RETURN
 
 
 ------- TBL OPEN routine ----- 
 tbopn:
 
 dbname$ = "memo.db"
 
 time y$, m$, d$, h$, n$, s$
 today$=y$+m$+d$+h$+n$+s$
 
 SQL.OPEN DB_Ptr, dbname$
 
 tbname$ = "memo001"
 c1$ = "kenmei"
 c2$ = "updymd"
 c3$ = "keisaif"
 c4$ = "kanren"
 c5$ = "naiyou"
 
 gosub menux
 RETURN
 
 !------- memo input routine ----- 
 mintbl:
 
 clipboard.get clzz$
 text.input azz$, clzz$,"メモ貼り付けフィールド"
 text.open w,flaa,"../../minput/temp.txt"
 text.writeln flaa,azz$
 popup "一時ファイルに出力しました",0,0,1
 pause 4000
 text.close flaa
 
 
 text.open r,file_number,"../../minput/temp.txt"
 
 Text.readln file_number,line$
 kenmei1$=line$
 
 keisaif1$="未"
 
 Text.readln file_number,line$
 kenren1$=line$
 all$=""
 while line$ <> "EOF"
   Text.readln file_number,line$
   if line$ <> "EOF" then
        all$=all$+line$+"\n"
   else
   endif 
 repeat
 Text.close file_number
 
 naiyou1$=all$
 
 popup "一時ファイル読込完了しました",0,0,1
 pause 4000
 
 
 GOSUB insert
 
 gosub menux
 return
 
 
 !------- input routine ----- 
 intbl:
 
 zzzz$=""
 
 while zzzz$<>"n"
    text.input kenmei1$,,"件名"
    keisaif1$="未"
    text.input kenren1$,,"このメモに関連するキーワード"
    text.input naiyou1$,,"メモの内容"
    GOSUB insert
    input "継続しますか？(y/n)",zzzz$
 repeat
 gosub menux
 return
 
 !------- TBL Insert routine ----- 
 insert:
 SQL.INSERT DB_Ptr, tbname$, c1$,kenmei1$,  c2$,today$, c3$,keisaif1$, c4$,kenren1$, c5$,naiyou1$
 Clipboard.put naiyou1$
 
 popup "クリップボードにメモの内容をコピーしました",0,0,1
 pause 5000
 
 RETURN
 
 !------- TBL Print routine ----- 
 pall:
 
 title$ = "全件データ一覧"
 
 Columns$ = "_id," + c1$  +"," + c2$ + "," +c3$ + "," + c4$ + "," + c5$
 
 SQL.QUERY Cursor, DB_Ptr, tbname$,  Columns$
 
 PRINT title$
 
 xdone = 0
 DO
  SQL.NEXT xdone,cursor,index$,v1$,v2$,v3$,v4$,v5$
  if !xdone THEN 
     PRINT  index$,v1$,v2$,v3$
     PRINT  v4$
     print  v5$
  endif   
 UNTIL xdone
 PRINT " "
 gosub menux
 RETURN
 
 !------- TBL Print(kenmei) routine ----- 
 pken:
 
 title$ = "件名一覧"
 
 Columns$ = "_id," + c1$  +"," + c2$ + "," +c3$
 
 SQL.QUERY Cursor, DB_Ptr, tbname$,  Columns$
 
 PRINT title$
 
 xdone = 0
 DO
  SQL.NEXT xdone,cursor,index$,v1$,v2$,v3$
  if !xdone THEN 
     PRINT  index$,v1$,v2$,v3$
  endif   
 UNTIL xdone
 PRINT " "
 gosub menux
 RETURN
 
 
 !------- DB kensaku routine ----- 
 kensak:
 
 input "検索文字列を入力してください。",jjj$
 
 Columns$ = "_id," + c1$  +"," + c2$ + "," +c3$ + "," + c4$ + "," + c5$
 
 Where$ = "kenmei like '%" + jjj$ + "%' OR kanren like '%" + jjj$ + "%' OR naiyou like '%" + jjj$ + "%'"
 
 SQL.QUERY Cursor, DB_Ptr, tbname$,  Columns$, Where$
 
 PRINT WHERE$;"の検索結果"
 
 xdone = 0
 DO
  SQL.NEXT xdone,cursor,index$,v1$,v2$,v3$,v4$,v5$
  if !xdone THEN 
     PRINT  index$,v1$,v2$,v3$,v4$,left$(v5$,10)
  endif   
 UNTIL xdone
 PRINT " "
 gosub menux
 RETURN
 
 !------- DB henkou routine ----- 
 henkou:
 
 input "検索文字列を入力してください。",jjj$
 
 Columns$ = "_id," + c1$  +"," + c2$ + "," +c3$ + "," + c4$ + "," + c5$
 
 Where$ = "kenmei like '%" + jjj$ + "%' OR kanren like '%" + jjj$ + "%' OR naiyou like '%" + jjj$ + "%'"
 
 SQL.QUERY Cursor, DB_Ptr, tbname$,  Columns$, Where$
 
 PRINT WHERE$;"の検索結果"
 
 xdone = 0
 DO
  SQL.NEXT xdone,cursor,index$,v1$,v2$,v3$,v4$,v5$
  if !xdone THEN 
     PRINT  index$,v1$,v2$,v3$,v4$,left$(v5$,10)
  endif   
 UNTIL xdone
 PRINT " "
 if tab$="y" then
    popup  "wait...",300,-150,1
    pause 5000
 else
 endif
 input "更新するメモ番号を指定 中止時はx",ckck$
 
 if ckck$="x" then 
 else
 
   Columns$ = "_id," + c1$  +"," + c2$ + "," +c3$ + "," + c4$ + "," + c5$
 
   Where$ = "_id = '" + ckck$ + "'"
 
   SQL.QUERY Cursor, DB_Ptr, tbname$,  Columns$, Where$
 
   PRINT WHERE$;"の検索結果"
 
   xdone = 0
   DO
    SQL.NEXT xdone,cursor,index$,v1$,v2$,v3$,v4$,v5$
    if !xdone THEN 
       PRINT  index$,v1$,v2$,v3$,v4$,v5$
    endif   
   UNTIL xdone
   PRINT " "
 
   text.input kenmei1$,v1$,"件名"
   Clipboard.put kenmei1$
   popup "クリップボードに件名をコピーしました",0,0,1
   pause 4000
 
   text.input keisaif1$,v3$,"掲載済フラグ"
   text.input kenren1$,v4$,"このメモに関連するキーワード"
   text.input naiyou1$,v5$,"メモの内容"
 
   SQL.UPDATE DB_Ptr, tbname$, c1$,kenmei1$,c2$,today$,c3$,keisaif1$,c4$,kenren1$,c5$,naiyou1$: Where$
 
   Clipboard.put naiyou1$
 
   popup "クリップボードにメモの内容をコピーしました",0,0,1
   pause 5000
 
   popup "更新完了",0,0,1
  
 endif
 
 gosub menux
 RETURN
 
 !------- flag henkou routine ----- 
 henkof:
 
 input "検索文字列を入力してください。",jjj$
 
 Columns$ = "_id," + c1$  +"," + c2$ + "," +c3$ + "," + c4$ + "," + c5$
 
 Where$ = "kenmei like '%" + jjj$ + "%' OR kanren like '%" + jjj$ + "%' OR naiyou like '%" + jjj$ + "%'"
 
 SQL.QUERY Cursor, DB_Ptr, tbname$,  Columns$, Where$
 
 PRINT WHERE$;"の検索結果"
 
 xdone = 0
 DO
  SQL.NEXT xdone,cursor,index$,v1$,v2$,v3$,v4$,v5$
  if !xdone THEN 
     PRINT  index$,v1$,v2$,v3$,v4$,left$(v5$,10)
  endif   
 UNTIL xdone
 PRINT " "
 if tab$="y" then
    popup  "wait...",300,-150,1
    pause 5000
 else
 endif
 input "掲載済フラグを更新するメモ番号を指定 中止時はx",ckck$
 
 if ckck$="x" then 
 else
 
   Columns$ = "_id," + c1$  +"," + c2$ + "," +c3$ + "," + c4$ + "," + c5$
 
   Where$ = "_id = '" + ckck$ + "'"
 
   SQL.QUERY Cursor, DB_Ptr, tbname$,  Columns$, Where$
 
   PRINT WHERE$;"の検索結果"
 
   xdone = 0
   DO
    SQL.NEXT xdone,cursor,index$,v1$,v2$,v3$,v4$,v5$
    if !xdone THEN 
       PRINT  index$,v1$,v2$,v3$,v4$,v5$
    endif   
   UNTIL xdone
   PRINT " "
 
   kenmei1$=v1$
 
   keisaif1$="済"
   kenren1$=v4$
   naiyou1$=v5$
 
   SQL.UPDATE DB_Ptr, tbname$, c1$,kenmei1$,c2$,today$,c3$,keisaif1$,c4$,kenren1$,c5$,naiyou1$: Where$
 
   popup "掲載済フラグを済に更新完了",0,0,1
  
 endif
 
 gosub menux
 RETURN
 
 
 
 !------- DB eturan routine ----- 
 eturan:
 
 input "検索文字列を入力してください。",jjj$
 
 Columns$ = "_id," + c1$  +"," + c2$ + "," +c3$ + "," + c4$ + "," + c5$
 
 Where$ = "kenmei like '%" + jjj$ + "%' OR kanren like '%" + jjj$ + "%' OR naiyou like '%" + jjj$ + "%'"
 
 SQL.QUERY Cursor, DB_Ptr, tbname$,  Columns$, Where$
 
 PRINT WHERE$;"の検索結果"
 
 xdone = 0
 DO
  SQL.NEXT xdone,cursor,index$,v1$,v2$,v3$,v4$,v5$
  if !xdone THEN 
     PRINT  index$,v1$,v2$,v3$,v4$,left$(v5$,10)
  endif   
 UNTIL xdone
 PRINT " "
 if tab$="y" then
    popup  "wait...",300,-150,1
    pause 5000
 else
 endif
 input "閲覧するメモ番号を指定 中止時はx",ckck$
 
 if ckck$="x" then 
 else
 
   Columns$ = "_id," + c1$  +"," + c2$ + "," +c3$ + "," + c4$ + "," + c5$
 
   Where$ = "_id = '" + ckck$ + "'"
 
   SQL.QUERY Cursor, DB_Ptr, tbname$,  Columns$, Where$
 
   PRINT WHERE$;"の検索結果"
 
   xdone = 0
   DO
    SQL.NEXT xdone,cursor,index$,v1$,v2$,v3$,v4$,v5$
    if !xdone THEN 
       PRINT  index$,v1$,v2$,v3$,v4$,v5$
    endif   
   UNTIL xdone
   PRINT " "
 
   tp$=v1$+"\n"+v5$  
 
   text.open w,flab,"../../minput/etemp.txt"
   text.writeln flab,tp$
   popup "一時ファイルに出力しました",0,0,1
   pause 4000
   text.close flab
 
   system.open
 
   aaax$="/system/bin/am start -a android.intent.action.VIEW -t \"text/plain\" "
   bbbx$="-c \"android.intent.category.DEFAULT\""
   dddx$=" -d file:/sdcard/minput/etemp.txt"
 
   cccx$=aaax$+bbbx$+dddx$
 
   popup cccx$,0,0,1
   pause 4000
   system.write cccx$
 
   pause 5000
 
   system.close
 
   Clipboard.put v1$
   input " クリップボードに件名をコピーしました ",et$,"y"
   Clipboard.put v5$
   input " クリップボードに内容をコピーしました ",etx$,"y"
  
 endif
 
 gosub menux
 RETURN
 
 
 !------- DB sakujo routine ----- 
 sakujo:
 
 input "検索文字列を入力してください。",jjj$
 
 Columns$ = "_id," + c1$  +"," + c2$ + "," +c3$ + "," + c4$ + "," + c5$
 
 Where$ = "kenmei like '%" + jjj$ + "%' OR kanren like '%" + jjj$ + "%' OR naiyou like '%" + jjj$ + "%'"
 
 SQL.QUERY Cursor, DB_Ptr, tbname$,  Columns$, Where$
 
 PRINT WHERE$;"の検索結果"
 
 xdone = 0
 DO
  SQL.NEXT xdone,cursor,index$,v1$,v2$,v3$,v4$,v5$
  if !xdone THEN 
     PRINT  index$,v1$,v2$,v3$,v4$,left$(v5$,10)
  endif   
 UNTIL xdone
 PRINT " "
 input "削除するメモ番号を指定 中止時はx",ckck$
 
 if ckck$="x" then 
 else
 
   Columns$ = "_id," + c1$  +"," + c2$ + "," +c3$ + "," + c4$ + "," + c5$
 
   Where$ = "_id = '" + ckck$ + "'"
 
   SQL.QUERY Cursor, DB_Ptr, tbname$,  Columns$, Where$
 
   PRINT WHERE$;"の検索結果"
 
   xdone = 0
   DO
    SQL.NEXT xdone,cursor,index$,v1$,v2$,v3$,v4$,v5$
    if !xdone THEN 
       PRINT  index$,v1$,v2$,v3$,v4$,v5$
    endif   
   UNTIL xdone
   PRINT " "
 
   input "このメモを削除します よろしいですか（y/n）",dldl$
   if dldl$="y" then
     SQL.DELETE DB_ptr, tbname$, Where$
   endif
   popup "削除完了",0,0,1
  
 endif
 
 gosub menux
 RETURN
 
 luch:
 SQL.CLOSE DB_Ptr
 popup "メモデータベースをクローズしました。",0,0,1
 pause 4000
 popup "ランチャーを起動します。",0,0,1
 pause 4000
 run "a-h2lunch1.bas"
 return
 
 !------- DB Close routine ----- 
 cldb:
 
 SQL.CLOSE DB_Ptr
 popup "メモデータベースをクローズしました。",0,0,1
 pause 5000
 
 
 ! ftp upload
 
 socket.myip ip$
 if ip$="" then
    return
 else
    popup "wi-fi接続済",0,0,1
    pause 4000
 endif
 
 HTML.OPEN
 
 HTML.LOAD.URL "ftpchke.html"
 
 xnextUserAction:
 
 ! loop until data$ is not ""
 
 DO
  HTML.GET.DATALINK data$
 UNTIL data$ <> ""
 
 type$ = LEFT$(data$, 4)
 
 data$ = MID$(data$,5)
 
 ! Act on the data type
 ! Shown are all the current data types
 
 SW.BEGIN type$
 
  ! Back Key hit.
  ! if we can go back then do it
  SW.CASE "BAK:"
   PRINT "BACK key: " + data$
   popup "強制終了します",0,0,0
   pause 2000
   EXIT
   SW.BREAK
 
  ! A hyperlink was clicked on
  SW.CASE "LNK:"
   PRINT "Hyperlink selected: "+ data$
   HTML.LOAD.URL data$
   array.delete aaa$[]
   split aaa$[],data$,"name="
   array.length laaa,aaa$[]
   print "URL ENCODE:";aaa$[2]
 
 
 
   SW.BREAK
 
  ! An error occured
  SW.CASE "ERR:"
   PRINT "Error: " + data$
   popup "エラーが発生しました 強制終了します",0,0,0
   pause 2000
   exit
   SW.BREAK
 
  ! User data returned
  SW.CASE "DAT:"
 !  PRINT "User data: " + data$
   
   ! Check for Exit
   IF data$ = "Exit"
    PRINT "FTP送信実施なし"
    HTML.CLOSE
    popup "FTP送信は実施しません",0,0,0
    pause 2000
    
    return
 
   else
    Decrypt "sinagawa",data$,decr$
    array.delete zza$[]
    split zza$[],decr$,"###"
    array.length lzza,zza$[]
    zzax$="FTP SERVER: "+zza$[1]+"\n"
    zzax$=zzax$+"FTP USER: "+zza$[2]+"\n"
    zzax$=zzax$+"FTP PASS: "+zza$[3]
    popup zzax$,0,0,1
    pause 4000
 
    
 
 
   ENDIF
   SW.BREAK
 
  ! Form data returned.
  ! Note: Form data returning
  ! always exits the html.
 
  SW.CASE "FOR:"
   PRINT "Form data: "+data$
   popup "強制終了します",0,0,0
   pause 2000
   exit
   SW.BREAK
 
 
 
  SW.DEFAULT
   PRINT "Unexpected data type:", type$ + data$
   popup "強制終了します",0,0,0
   pause 2000
   exit
 
 SW.END
 
 
 
 popup "Connecting to ftp server...",0,0,1
 pause 4000
 
 ! Set the default path
 
 path$=zza$[1]
 fusr$=zza$[2]
 fpas$=zza$[3]
 
 FTP.OPEN path$, 21, fusr$, fpas$
 
 ! Clear the default path
 
 path$="/"
 
 !goto fup
 
 FTP.DIR ftplist
 
 list.size ftplist,fsize
 
 for i=1 to fsize
    list.get ftplist,i,fname$
    print fname$
 next i
 
 !fup:
 
 zzz$="../databases/memo.db"
 
 yyy$="memo.db"
 
 POPUP "UPloading メモデータベース...", 0, 0, 1
 pause 4000
 
 FTP.put zzz$, yyy$
 
 
 popup "UPload complete!",0,0,1
 PAUSE 4000 % Pause for a little
 
 popup "FTP close process start!",0,0,1
 pause 4000
 
 Ftp.close
 
 PAUSE 1000 % Pause for a little
 
 POPUP "メモデータベースUPload 終了", 0, 0, 1
 pause 4000
 html.close
 
 return
 
 onbackkey:
 jjj=1
 back.resume