« previous next »
Pages: [1] 2   Go Down

Author Topic: Problem whith install in windows 10 Home  (Read 7368 times)

0 Members and 1 Guest are viewing this topic.

Offline Juanjogomez

  • Forum Regular
  • Posts: 117
    • View Profile
Problem whith install in windows 10 Home
« on: April 27, 2020, 02:44:32 am »
This is one of the posts that were lost on the afternoon of the 26th due to the server failure.

In it, I asked for help because the programs that I have made -and sold- to a client do not work on their computer. They simply go out when you finch on them (they don't even open).

After several posts and suggestions from other forum members, in which you told me to remove antivirus, Wwindows Defender and put it on the firewall whitelist, and given the problem that it remains exactly the same, my last question was that if not It would be because of the graphics card, although the program does not use graphics, only text, as it is a billing program.
The graphics card has a maximum resolution of 1440x900 and the processor is a 1900 Intel Celeron
Logged

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: Problem whith install in windows 10 Home
« Reply #1 on: April 27, 2020, 03:42:31 am »
I'm guessing if you sold it, it is NOT source, just the exe. If so, what version of QB64 was it made in? I really can't recall if any version of SDL can't run in Win 10, 64-bit. I have the last SDL version made on my Win 10 Home 64-bit, and I can compile and run programs on it. As far as the anti-virus, if this is an exe program, it would have to be whitelisted by name and folder name. Again, I'm guessing your client doesn't have a QB64 folder, or the source code, just the exe file and whatever folder that was installed in. If it was installed in one of the Windows programs files, I'd try copying it to a non-windows folder, and see if it would at least open. Of course if it uses data files, and they are in the Windows Programs folder, that isn't going to solve for actually using the program, but it would give you an idea if Windows folder permissions are interfering with it or not. Also, if the client has a desktop icon to launch it or can access it through explorer, right click and select "Run as Administrator" and see if that solves the problem.

By the way, I've never had to whitelist a non-Windows folder QB64 exe program from windows Defender, but other anti-virus, like Norton, Avast, etc., require that you do whitelist QB64 exe files.

Pete
Logged
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

FellippeHeitor

  • Guest
Re: Problem whith install in windows 10 Home
« Reply #2 on: April 27, 2020, 06:22:43 am »
It could be a graphics card issue. Keep in mind that, unless you're outputting to $CONSOLE:ONLY, even a SCREEN 0 window is a graphic window with QB64, as we use OpenGL for rendering. - Sorry, Pete.
Logged

Offline EricE

  • Forum Regular
  • Posts: 114
    • View Profile
Re: Problem whith install in windows 10 Home
« Reply #3 on: April 27, 2020, 06:24:47 am »
Hello Juanjogomez,

What are the differences between your computer, the development computer, and the customer's computer?
In those differences might be the reason the program does not run, or even open, on the customer computer.
Logged

Offline Juanjogomez

  • Forum Regular
  • Posts: 117
    • View Profile
Re: Problem whith install in windows 10 Home
« Reply #4 on: April 27, 2020, 06:37:18 am »
Hi at all
The program is all done on screen 0, that is 25x80 characters.
I have a computer with windows 7 64 bits, another with windows 8 32 bits and two others with windows 10 Pro 64 bits.
The client has a computer with Windows XP (in which it works correctly), or a laptop with Windows 10 (I don't know if home, bussines ...) 64 bits in which it also works correctly, and another desktop computer with Windows 10 Home 64 bit, which is the one that doesn't work.

The program folder is not inside the windows folder and the data is in a MariaDb 10 database.

As Pete, I've never had to whitelist a non-Windows folder QB64 exe program from windows Defender, and I have Avast on all my computers without problem

Logged

Offline Juanjogomez

  • Forum Regular
  • Posts: 117
    • View Profile
Re: Problem whith install in windows 10 Home
« Reply #5 on: April 27, 2020, 06:41:22 am »
Regarding if it is a graphic card problem, what is the minimum card or what configuration should it have?

Juanjo Gómez
Logged

FellippeHeitor

  • Guest
Re: Problem whith install in windows 10 Home
« Reply #6 on: April 27, 2020, 08:37:30 am »
Nah, you said the IDE runs there, so it's not that.

Also, there have been some minor cases in which the proper drivers were not installed caused issues for some people, not a specific graphic card requirement issue.
Logged

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: Problem whith install in windows 10 Home
« Reply #7 on: April 27, 2020, 02:06:00 pm »
Since this is for business use. I'd recommend your client buy a new desktop computer. Ones to run business apps, not games, are dirt cheap these days. Over the years, I had 5 computers, all different with different OS's. to run my QB business programs. If I ever put those apps on a computer and they wouldn't run, I'd just get another computer, rather than fiddle with hardware issues. I did know a pretty good hardware guy, so I maybe i would have given him a shot at it, first. Your client might want to do the same. Just tell him, Dammit Jim, I'm a programmer, not a manufacture! If he's a Star Trek fan, he'll get that. If he's a Star Wars fan, he deserves not to have working programs, a house, a livelihood, oh, or a toothbrush.

Pete
Logged
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

Offline Juanjogomez

  • Forum Regular
  • Posts: 117
    • View Profile
Re: Problem whith install in windows 10 Home
« Reply #8 on: April 28, 2020, 02:28:28 am »
Thank you

I have told you to factory reset the computer, to see if there is any internal Windows deconfiguration.
I'll comment on what happened in the end.

Juanjo Gómez
Logged

Offline krovit

  • Forum Regular
  • Posts: 179
    • View Profile
Re: Problem whith install in windows 10 Home
« Reply #9 on: May 04, 2020, 05:56:56 pm »
hi!
maybe you should try to see if your app works on windows 10 pro. Maybe you developed and tested the code with windows 7 professional or windows 10 pro, and didn't try it on win10 home.

The home version (not to mention the N version with which you can't do anything but consult your mail and a little more) has a very bad tendency to consider only the official apps downloaded from recognized sites (those of windows!) and not those of third parties (for example your EXE).
Maybe there for them seems to have installed your EXE but then... do as he likes.

This is a known issue that had already been announced (and feared) with the advent of windows 10: on the lower versions of the pro some programs may not work or cannot be installed.

I don't know if this restriction is better or if something's wrong with your EXE.



Logged
Nothing is easy, especially when it appears simple (and nothing could be as dangerous as trying to do good to others)

Offline Juanjogomez

  • Forum Regular
  • Posts: 117
    • View Profile
Re: Problem whith install in windows 10 Home
« Reply #10 on: May 09, 2020, 11:29:43 am »
Hi!
Thanks for that information.
I am waiting for the client to install a higher version of Windows 10.
Logged

Offline Juanjogomez

  • Forum Regular
  • Posts: 117
    • View Profile
Re: Problem whith install in windows 10 Home
« Reply #11 on: June 08, 2020, 11:18:51 am »
I go back to the thread and I am desperate.
The client has installed a higher version of windows 10 and the program still does not work.
What's more, I have been testing and there are some of the programs that make it up (there are 32 programs in total) that do work and others do not on your computer).
I have installed the group of programs on my son's computer, which has the same operating system as mine ... windows 10 Pro, with a better graphics card and more memory than mine, and the same thing happens, some programs work and others not.
The worst thing is that I have installed on my son's computer QB64 1.3 32 bits, which is the one I work with, and I have loaded one of the programs that does not work, and when I hit F5, it tries to compile (the screen is set darker), but in the end it returns to the interpreter, so it does not work even from the interpreter.
I honestly don't know what to do and I get the feeling that I have thrown away more than 1 year of programming with a Qb64 incompatibility problem with some computers.
I hope someone can find a solution to my problem because right now I am blocked. I cannot market a program that works on some computers if and on others it does not.

I am attaching one of those that does not work. The Options MENU program

Code: QB64: [Select]
  1. ON ERROR GOTO 15000
  2. COMMON SHARED todobien
  3. 'IF todobien = 0 THEN PRINT "ACCESO DENEGADO": x$ = INPUT$(1): SYSTEM
  5.  
  6. OPEN "c:\ALMAv10\SERVIDOR.DAT" FOR INPUT AS 1
  7. LINE INPUT #1, a$
  8. servidor$ = _TRIM$(a$)
  9. LINE INPUT #1, a$
  10. usuario$ = _TRIM$(a$)
  11. LINE INPUT #1, a$
  12. clave$ = _TRIM$(a$)
  13. LINE INPUT #1, a$
  14. bdatos$ = _TRIM$(a$)
  15. LINE INPUT #1, a$
  16. puerto = VAL(a$)
  18.  
  19. 'servidor$ = "127.0.0.1"
  20. 'usuario$ = "root"
  21. 'clave$ = "1451"
  22. 'bdatos$ = "ALMA20"
  23. 'puerto = 0
  24.  
  26. conn = mysql_init(0)
  28. REDIM SHARED DB_RESULT(columns, rows) AS STRING
  29. 'PRINT "MYSQL Client: " + mysql_get_client_info$
  30.  
  31. IF conn = 0 THEN
  32.     PRINT "No puedo iniciar MYSQL client!": SLEEP (0): x$ = INKEY$
  34.  
  35. DIM conexion AS _OFFSET
  36. '*** Abrir Base de Datos ***
  37. conexion = mysql_real_connect(conn, servidor$, usuario$, clave$, bdatos$, puerto, 0, 0)
  38. IF conexion = 0 THEN PRINT "NO HE PODIDO CONECTAR CON EL SERVIDOR": x$ = INPUT$(1)
  39.  
  40. busclave$ = "SELECT * FROM const WHERE  id= '1'" + CHR$(0)
  41. CALL basedato(busclave$, rows, columns)
  42. fechoy$ = RIGHT$(DB_RESULT(4, 1), 2) + MID$(DB_RESULT(4, 1), 6, 2) + MID$(DB_RESULT(4, 1), 3, 2)
  43. empresa$ = SPACE$(5) + DB_RESULT(24, 1) + SPACE$(40 - LEN(DB_RESULT(24, 1))) + SPACE$(22)
  44. empresa$ = empresa$ + LEFT$(fechoy$, 2) + "/" + MID$(fechoy$, 3, 2) + "/" + RIGHT$(fechoy$, 2) + SPACE$(5)
  45. dd1$ = DB_RESULT(24, 1) + SPACE$(30 - LEN(DB_RESULT(24, 1)))
  46. dd2$ = DB_RESULT(25, 1) + SPACE$(30 - LEN(DB_RESULT(25, 1)))
  47. dd3$ = DB_RESULT(26, 1) + SPACE$(30 - LEN(DB_RESULT(26, 1)))
  48. opnoiva = VAL(DB_RESULT(54, 1))
  49. maxlaser = VAL(DB_RESULT(61, 1))
  50. op = VAL(DB_RESULT(56, 1))
  51.  
  52. ON TIMER(1) GOSUB 17000
  53.  
  54. 100 '---------------------------------------------------------------------------
  55. '------------------------------- MENU GENERAL ------------------------------
  56. '---------------------------------------------------------------------------
  57. COLOR 7, 0
  59. FOR n% = 1 TO 25
  60.     PRINT STRING$(80, 176);
  62. COLOR 7, 4
  63. LOCATE 2, 2: PRINT "  "; dd1$; "  "
  64. LOCATE 3, 2: PRINT "  "; dd2$; "  "
  65. LOCATE 4, 2: PRINT "  "; dd3$; "  "
  66. COLOR 7, 0
  67. LOCATE 3, 36: PRINT " ": LOCATE 4, 36: PRINT " ": LOCATE 5, 3: PRINT SPC(34);
  68. COLOR 7, 4
  69. LOCATE 2, 49: PRINT "  ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿  "
  70. LOCATE 3, 49: PRINT "  ³ ALMACEN S.Q.L   v.10.0 ³  "
  71. LOCATE 4, 49: PRINT "  ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ  "
  72. COLOR 7, 0
  73. LOCATE 3, 79: PRINT " ": LOCATE 4, 79: PRINT " ": LOCATE 5, 50: PRINT SPC(30);
  74. COLOR 0, 2
  75. LOCATE 18, 2: PRINT " ÚÄÄÄÄÄÄ¿ "
  76. LOCATE 19, 2: PRINT " ³  JJ  ³ "
  77. LOCATE 20, 2: PRINT " ³ Soft ³ "
  78. LOCATE 21, 2: PRINT " ÀÄÄÄÄÄÄÙ "
  79. COLOR 7, 0
  80. LOCATE 19, 12: PRINT " ": LOCATE 20, 12: PRINT " "
  81. LOCATE 21, 12: PRINT " ": LOCATE 22, 3: PRINT SPC(10);
  82. COLOR 1, 7
  83. LOCATE 7, 20: PRINT " ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ» "
  84. LOCATE 8, 20: PRINT " º ";
  85. COLOR 15, 1
  86. PRINT "             M E N U              ";
  87. COLOR 1, 7
  88. PRINT " º "
  89. LOCATE 9, 20: PRINT " ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ "
  90. LOCATE 10, 20: PRINT " º  1.- Ficheros Maestros.            º "
  91. LOCATE 11, 20: PRINT " º  2.- Entrada y Venta.              º "
  92. LOCATE 12, 20: PRINT " º  3.- Cuadre de Venta.              º "
  93. LOCATE 13, 20: PRINT " º  4.- Gesti¢n de Facturas.          º "
  94. LOCATE 14, 20: PRINT " º  5.- Gesti¢n de Impuestos.         º "
  95. LOCATE 15, 20: PRINT " º  6.- Arqueo y Final.               º "
  96. LOCATE 16, 20: PRINT " º  7.- Programas Auxiliares.         º "
  97. LOCATE 17, 20: PRINT " ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ "
  98. COLOR 7, 0
  99. FOR n% = 8 TO 17
  100.     LOCATE n%, 60: PRINT " "
  101. NEXT n%
  102. LOCATE 18, 21: PRINT SPC(40);
  103. COLOR 7, 1
  104. LOCATE 24, 1: PRINT "    Fecha                                                                Hora   ";
  105. LOCATE 25, 1: PRINT "    "; LEFT$(fechoy$, 2); "/"; MID$(fechoy$, 3, 2);
  106. PRINT "/"; RIGHT$(fechoy$, 2); SPACE$(68);
  107. PCOPY 0, 1
  109. IF op > 100 AND op < 200 THEN GOTO op1
  110. IF op > 200 AND op < 300 THEN GOTO op2
  111. IF op > 300 AND op < 400 THEN GOTO op3
  112. IF op > 400 AND op < 500 THEN GOTO op4
  113. IF op > 500 AND op < 600 THEN GOTO op5
  114. IF op > 600 AND op < 700 THEN GOTO op6
  115. IF op > 700 AND op < 800 THEN GOTO op7
  116. 500 x$ = INKEY$: IF x$ = "" THEN 500
  117. IF x$ = "1" THEN GOTO op1
  118. IF x$ = "2" THEN GOTO op2
  119. IF x$ = "3" THEN GOTO op3
  120. IF x$ = "4" THEN GOTO op4
  121. IF x$ = "5" THEN GOTO op5
  122. IF x$ = "6" THEN GOTO op6
  123. IF x$ = "7" THEN GOTO op7
  124. IF x$ = CHR$(27) THEN 2000
  125. GOTO 500
  126.  
  127. op1:
  128. '----------------------- VENTANA DE OPCION 1 ------------------------------
  130. COLOR 0, 2
  131. LOCATE 10, 30: PRINT " ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ» "
  132. LOCATE 11, 30: PRINT " º ";
  133. COLOR 15, 0
  134. PRINT "  1.- Ficheros Maestros.          ";
  135. COLOR 0, 2
  136. PRINT " º "
  137. LOCATE 12, 30: PRINT " ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ "
  138. LOCATE 13, 30: PRINT " º  1.- Fichero de Clientes.          º "
  139. LOCATE 14, 30: PRINT " º  2.- Fichero de Proveedores.       º "
  140. LOCATE 15, 30: PRINT " º  3.- Fichero de Art¡culos.         º "
  141. LOCATE 16, 30: PRINT " º  4.- Fichero de Datos Generales.   º "
  142. LOCATE 17, 30: PRINT " º  5.- Fichero de Tipos de IVA.      º "
  143. LOCATE 18, 30: PRINT " ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ "
  144. COLOR 7, 0
  145. FOR n% = 11 TO 18
  146.     LOCATE n%, 70: PRINT " "
  147. NEXT n%
  148. LOCATE 19, 31: PRINT SPC(40);
  150. 1080 x$ = INKEY$: IF x$ = "" THEN 1080
  151. IF ASC(x$) = 27 THEN PCOPY 1, 0: GOTO 500
  152. IF x$ = "1" THEN c$ = "110": b$ = "FICLI": GOTO 32000
  153. IF x$ = "2" THEN c$ = "120": b$ = "FIPRO": GOTO 32000
  154. IF x$ = "3" THEN c$ = "130": b$ = "FIART": GOTO 32000
  155. IF x$ = "4" THEN c$ = "140": b$ = "FIDAT": GOTO 32000
  156. IF x$ = "5" THEN c$ = "150": b$ = "FICHEIVA": GOTO 32000
  157. GOTO 1080
  158.  
  159. op2:
  160. '----------------------- VENTANA DE OPCION 2 ------------------------------
  162. COLOR 0, 2
  163. LOCATE 10, 30: PRINT " ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ» "
  164. LOCATE 11, 30: PRINT " º ";
  165. COLOR 15, 0
  166. PRINT "  2.- Entrada y Venta.            ";
  167. COLOR 0, 2
  168. PRINT " º "
  169. LOCATE 12, 30: PRINT " ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ "
  170. LOCATE 13, 30: PRINT " º  1.- Entrada de Art¡culos.         º "
  171. LOCATE 14, 30: PRINT " º  2.- Existencias/Precios.          º "
  172. LOCATE 15, 30: PRINT " º  3.- Listas de Precios(ABC).       º "
  173. LOCATE 16, 30: PRINT " º  4.- Listas de Precios(Individual).º "
  174. LOCATE 17, 30: PRINT " º  5.- Albaranes/Facturaci¢n.        º "
  175. LOCATE 18, 30: PRINT " º  6.- Listado de Albaranes.         º "
  176. LOCATE 19, 30: PRINT " º  7.- Lista de Kilos por periodo.   º "
  177. LOCATE 20, 30: PRINT " ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ "
  178. COLOR 7, 0
  179. FOR n% = 11 TO 20
  180.     LOCATE n%, 70: PRINT " "
  181. NEXT n%
  182. LOCATE 21, 31: PRINT SPC(40);
  184. 3580 x$ = INKEY$: IF x$ = "" THEN 3580
  185. IF ASC(x$) = 27 THEN PCOPY 1, 0: GOTO 500
  186. IF x$ = "1" THEN c$ = "210": b$ = "ENTRAGEN": GOTO 32000
  187. IF x$ = "2" THEN c$ = "220": b$ = "LISEXIST": GOTO 32000
  188. IF x$ = "3" THEN c$ = "230": b$ = "LISTAPRE": GOTO 32000
  189. IF x$ = "4" THEN c$ = "240": b$ = "LISPRECI": GOTO 32000
  190. IF x$ = "5" THEN c$ = "250": b$ = "ALBARANE": GOTO 32000
  191. IF x$ = "6" THEN c$ = "260": b$ = "LISALBCL": GOTO 32000
  192. IF x$ = "7" THEN c$ = "270": b$ = "LISTAKIL": GOTO 32000
  193. GOTO 3580
  194.  
  195. op3:
  196. '----------------------- VENTANA DE OPCION 3 ------------------------------
  198. COLOR 0, 2
  199. LOCATE 10, 30: PRINT " ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ» "
  200. LOCATE 11, 30: PRINT " º ";
  201. COLOR 15, 0
  202. PRINT "  3.- Cuadre de Venta.            ";
  203. COLOR 0, 2
  204. PRINT " º "
  205. LOCATE 12, 30: PRINT " ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ "
  206. LOCATE 13, 30: PRINT " º  1.- Listado por Art¡culos.        º "
  207. LOCATE 14, 30: PRINT " º  2.- Correcci¢n de Errores.        º "
  208. LOCATE 15, 30: PRINT " º  3.- Listado Total de Venta.       º "
  209. LOCATE 16, 30: PRINT " º  4.- Actualizar Venta.             º "
  210. LOCATE 17, 30: PRINT " º  5.- Listado por Art¡culos/Cliente.º "
  211. LOCATE 18, 30: PRINT " ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ "
  212. COLOR 7, 0
  213. FOR n% = 11 TO 18
  214.     LOCATE n%, 70: PRINT " "
  215. NEXT n%
  216. LOCATE 19, 31: PRINT SPC(40);
  218. IF op = 311 OR op = 312 THEN GOTO op31
  219. IF op = 351 OR op = 352 OR 353 THEN GOTO op35
  220. 4580 x$ = INKEY$: IF x$ = "" THEN 4580
  221. IF ASC(x$) = 27 THEN PCOPY 1, 0: GOTO 500
  222. IF x$ = "1" THEN GOTO op31
  223. IF x$ = "2" THEN c$ = "320": b$ = "ALTERAN": GOTO 32000
  224. IF x$ = "3" THEN c$ = "330": b$ = "LISTOT": GOTO 32000
  225. IF x$ = "4" THEN c$ = "340": b$ = "ACTUCAJA": GOTO 32000
  226. IF x$ = "5" THEN GOTO op35
  227. GOTO 4580
  228.  
  229. op31:
  230. '----------------------- VENTANA DE OPCION 3.1 ----------------------------
  231. PCOPY 0, 2
  233. COLOR 0, 6
  234. LOCATE 13, 40: PRINT " ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ» "
  235. LOCATE 14, 40: PRINT " º ";
  236. COLOR 15, 0
  237. PRINT "  3.1.- Listado por Art¡culos.    ";
  238. COLOR 0, 6
  239. PRINT " º "
  240. LOCATE 15, 40: PRINT " ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ "
  241. LOCATE 16, 40: PRINT " º  1.- Individual por Pantalla.      º "
  242. LOCATE 17, 40: PRINT " º  2.- Total por Impresora.          º "
  243. LOCATE 18, 40: PRINT " ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ "
  244. COLOR 7, 0
  245. FOR n% = 14 TO 18
  246.     LOCATE n%, 80: PRINT " "
  247. NEXT n%
  248. LOCATE 19, 41: PRINT SPC(40);
  250. 8580 x$ = INKEY$: IF x$ = "" THEN 8580
  251. IF ASC(x$) = 27 THEN op = 310: PCOPY 2, 0: GOTO 4580
  252. IF x$ = "1" THEN c$ = "311": b$ = "LISART": GOTO 32000
  253. IF x$ = "2" THEN c$ = "312": b$ = "LISART": GOTO 32000
  254. GOTO 8580
  255.  
  256. op35:
  257. '----------------------- VENTANA DE OPCION 3.5 ----------------------------
  258. PCOPY 0, 2
  260. COLOR 0, 6
  261. LOCATE 13, 40: PRINT " ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ» "
  262. LOCATE 14, 40: PRINT " º ";
  263. COLOR 15, 0
  264. PRINT "  3.5.- Listado por Art./Clientes.";
  265. COLOR 0, 6
  266. PRINT " º "
  267. LOCATE 15, 40: PRINT " ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ "
  268. LOCATE 16, 40: PRINT " º  1.- Individual por Pantalla.      º "
  269. LOCATE 17, 40: PRINT " º  2.- Individual por Impresora      º "
  270. LOCATE 18, 40: PRINT " º  3.- Total por Impresora.          º "
  271. LOCATE 19, 40: PRINT " ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ "
  272. COLOR 7, 0
  273. FOR n% = 14 TO 19
  274.     LOCATE n%, 80: PRINT " "
  275. NEXT n%
  276. LOCATE 20, 41: PRINT SPC(40);
  278. 9090 x$ = INKEY$: IF x$ = "" THEN 9090
  279. IF ASC(x$) = 27 THEN op = 320: PCOPY 2, 0: GOTO 4580
  280. IF x$ = "1" THEN c$ = "321": b$ = "LISARCLI": GOTO 32000
  281. IF x$ = "2" THEN c$ = "322": b$ = "LISARCLI": GOTO 32000
  282. IF x$ = "3" THEN c$ = "323": b$ = "LISARCLI": GOTO 32000
  283. GOTO 9090
  284.  
  285. op4:
  286. '---------------------- VENTANA DE OPCION 4 ------------------------------
  288. COLOR 0, 2
  289. LOCATE 10, 30: PRINT " ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ» "
  290. LOCATE 11, 30: PRINT " º ";
  291. COLOR 15, 0
  292. PRINT "  4.- Gesti¢n de Facturas.        ";
  293. COLOR 0, 2
  294. PRINT " º "
  295. LOCATE 12, 30: PRINT " ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ "
  296. LOCATE 13, 30: PRINT " º  1.- Facturacion.                  º "
  297. LOCATE 14, 30: PRINT " º  2.- Facturacion (Precios Medios). º "
  298. LOCATE 15, 30: PRINT " º  3.- Cambiar Estado de Facturas y  º "
  299. LOCATE 16, 30: PRINT " º      Reimprimir Facturas.          º "
  300. LOCATE 17, 30: PRINT " º  4.- Gestion de Facturas de Compra º "
  301. LOCATE 18, 30: PRINT " ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ "
  302. COLOR 7, 0
  303. FOR n% = 11 TO 18
  304.     LOCATE n%, 70: PRINT " "
  305. NEXT n%
  306. LOCATE 19, 31: PRINT SPC(40);
  308. 13080 x$ = INKEY$: IF x$ = "" THEN 13080
  309. IF ASC(x$) = 27 THEN PCOPY 1, 0: GOTO 500
  310. IF x$ = "1" THEN c$ = "410": b$ = "FACTURAS": GOTO 32000
  311. IF x$ = "2" THEN c$ = "420": b$ = "FACTURA2": GOTO 32000
  312. IF x$ = "3" THEN c$ = "430": b$ = "ANULACLI": GOTO 32000
  313. IF x$ = "4" THEN c$ = "440": b$ = "IVACOMPR": GOTO 32000
  314. GOTO 13080
  315.  
  316. op5:
  317. '----------------------- VENTANA DE OPCION 5 ------------------------------
  319. COLOR 0, 2
  320. LOCATE 10, 30: PRINT " ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ» "
  321. LOCATE 11, 30: PRINT " º ";
  322. COLOR 15, 0
  323. PRINT "  5.- Gesti¢n de Impuestos.              ";
  324. COLOR 0, 2
  325. PRINT " º "
  326. LOCATE 12, 30: PRINT " ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ "
  327. LOCATE 13, 30: PRINT " º  1.- Listado I.V.A. de Clientes.          º "
  328. LOCATE 14, 30: PRINT " º  2.- Listado Anual Ventas a Clientes.     º "
  329. LOCATE 15, 30: PRINT " º  3.- Listado Anual Compras a Proveedores. º "
  330. LOCATE 16, 30: PRINT " º  4.- Listado Facturas de Clientes.        º "
  331. LOCATE 17, 30: PRINT " ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ "
  332. COLOR 7, 0
  333. FOR n% = 11 TO 17
  334.     LOCATE n%, 77: PRINT " "
  335. NEXT n%
  336. LOCATE 18, 31: PRINT SPC(47);
  338. 8080 x$ = INKEY$: IF x$ = "" THEN 8080
  339. IF ASC(x$) = 27 THEN PCOPY 1, 0: GOTO 500
  340. IF x$ = "1" THEN c$ = "510": b$ = "LISIVACL": GOTO 32000
  341. IF x$ = "2" THEN c$ = "520": b$ = "LISBASCL": GOTO 32000
  342. IF x$ = "3" THEN c$ = "530": b$ = "LISBASPR": GOTO 32000
  343. IF x$ = "4" THEN c$ = "540": b$ = "LISCLIFA": GOTO 32000
  344. GOTO 8080
  345.  
  346. op6:
  347. '---------------------- VENTANA DE OPCION 6 ------------------------------
  349. COLOR 0, 2
  350. LOCATE 10, 30: PRINT " ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ» "
  351. LOCATE 11, 30: PRINT " º ";
  352. COLOR 15, 0
  353. PRINT "  6.- Arqueo y Final.             ";
  354. COLOR 0, 2
  355. PRINT " º "
  356. LOCATE 12, 30: PRINT " ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ "
  357. LOCATE 13, 30: PRINT " º  1.- Arqueo de Caja.               º "
  358. LOCATE 14, 30: PRINT " º  2.- Borrado de Datos de Hoy y     º "
  359. LOCATE 15, 30: PRINT " º      Preparaci¢n para Ma¤ana.      º "
  360. LOCATE 16, 30: PRINT " º  3.- Consulta de Arqueos de Caja.  º "
  361. LOCATE 17, 30: PRINT " ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ "
  362. COLOR 7, 0
  363. FOR n% = 11 TO 17
  364.     LOCATE n%, 70: PRINT " "
  365. NEXT n%
  366. LOCATE 18, 31: PRINT SPC(40);
  368. 13580 x$ = INKEY$: IF x$ = "" THEN 13580
  369. IF ASC(x$) = 27 THEN PCOPY 1, 0: GOTO 500
  370. IF x$ = "1" THEN c$ = "610": b$ = "ARQUEO": GOTO 32000
  371. IF x$ = "2" THEN c$ = "620": b$ = "BORRAR": GOTO 32000
  372. IF x$ = "3" THEN c$ = "630": b$ = "HISARQUE": GOTO 32000
  373. GOTO 13580
  374.  
  375. op7:
  376. '---------------------------- VENTANA DE PROGRAMAS AUXILIARES -------------------
  378. COLOR 0, 2
  379. LOCATE 10, 30: PRINT " ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ» "
  380. LOCATE 11, 30: PRINT " º ";
  381. COLOR 15, 0
  382. PRINT "  7.- Programas Auxiliares         ";
  383. COLOR 0, 2
  384. PRINT " º "
  385. LOCATE 12, 30: PRINT " ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ "
  386. LOCATE 13, 30: PRINT " º  1.- Obt. C. de Seg. a Pendrive.    º "
  387. LOCATE 14, 30: PRINT " º  2.- Res. C. de Seg. desde Pendrive.º "
  388. LOCATE 15, 30: PRINT " º  3.- Impresora Predeterminada.      º "
  389. LOCATE 16, 30: PRINT " º  4.- Utilidades.                    º "
  390. LOCATE 17, 30: PRINT " º                                     º "
  391. LOCATE 18, 30: PRINT " º  0.- Crear un NUEVO PERIODO.        º "
  392. LOCATE 19, 30: PRINT " ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ "
  393. COLOR 7, 0
  394. FOR n% = 11 TO 19
  395.     LOCATE n%, 71: PRINT " "
  396. NEXT n%
  397. LOCATE 20, 31: PRINT SPC(41);
  399. 1580 x$ = INKEY$: IF x$ = "" THEN 1580
  400. IF ASC(x$) = 27 THEN PCOPY 1, 0: GOTO 500
  401. IF x$ = "1" THEN GOTO op71
  402. IF x$ = "2" THEN GOTO op72
  403. IF x$ = "3" THEN CALL predeter(impresora$)
  404. IF x$ = "4" THEN c$ = "740": b$ = "UTILALM": GOTO 32000
  405. IF x$ = "0" THEN c$ = "790": b$ = "NPERIODO": GOTO 32000
  406. GOTO 1580
  407.  
  408. op71:
  409. '--------------------- OBTENER COPIA DE SEGURIDAD -------------------------
  410. PCOPY 0, 2
  412. COLOR 0, 6
  413. LOCATE 13, 40: PRINT " ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ» "
  414. LOCATE 14, 40: PRINT " º ";
  415. COLOR 15, 0
  416. PRINT " 7.1.- Obtener Copia de Seguridad ";
  417. COLOR 0, 6
  418. PRINT " º "
  419. LOCATE 15, 40: PRINT " ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ "
  420. LOCATE 16, 40: PRINT " º                                    º "
  421. LOCATE 17, 40: PRINT " º PenDrive...(D,E,F,G,etc):          º "
  422. LOCATE 18, 40: PRINT " º                                    º "
  423. LOCATE 19, 40: PRINT " ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ "
  424. COLOR 7, 0
  425. FOR n% = 14 TO 20
  426.     LOCATE n%, 80: PRINT " "
  427. NEXT n%
  428. LOCATE 20, 41: PRINT SPC(40);
  430. COLOR 15, 0
  431. 2660 y = 17: x = 69: a$ = "": l = 1: sp = 1: nu$ = "T"
  432. CALL rutimput(y, x, a$, l, ant, sp, nu$)
  433. IF ant = 2 THEN
  434.     PCOPY 2, 0
  435.     GOTO 1580
  437. a$ = UCASE$(a$)
  438. IF a$ <> "" THEN
  439.     disco = INSTR("DEFGHIJKLMN¥OPQRSTUVWXYZ", a$)
  440.     IF disco = 0 THEN GOTO 2660
  442.  
  443. backu$ = "CMD /C c:\almav10\mysqldump -v --host=" + servidor$ + " --user=" + usuario$ + " --password=" + clave$ + " --port=" + LTRIM$(STR$(puerto)) + " --add-drop-database --databases " + bdatos$ + " > " + a$ + ":" + "COPIA" + bdatos$ + ".sql"
  444. COLOR 15, 0
  446. PRINT "********************************************************************************"
  447. PRINT "*************** HACIENDO COPIA DE SEGURIDAD DE LA BASE DE DATOS ****************"
  448. PRINT "********************************************************************************"
  449. SHELL backu$
  450.  
  451. IF _DIREXISTS("c:\ALMAv10\ARCHIVOS") THEN
  452.     PRINT "********************************************************************************"
  453.     PRINT "************* HACIENDO COPIA DE SEGURIDAD DE LA CARPETA 'ARCHIVOS' *************"
  454.     PRINT "********************************************************************************"
  455.     backu$ = "CMD /C XCOPY c:\ALMAv10\ARCHIVOS\*.* " + a$ + ":\ARCHIVOS\ /Y /V /S /E"
  456.     SHELL backu$
  458.  
  459. 2680 COLOR 25, 7
  461. PRINT "                             PULSE UNA TECLA PARA CONTINUAR                  ";
  463. x$ = INPUT$(1): x$ = ""
  464. COLOR 7, 0
  465. PCOPY 2, 0
  466. GOTO 1580
  467.  
  468. op72:
  469. '----------------------- VENTANA DATOS DE RESTORE -------------------------
  470. PCOPY 0, 2
  472. COLOR 7, 4
  473. LOCATE 13, 40: PRINT " ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ» "
  474. LOCATE 14, 40: PRINT " º ";
  475. COLOR 15, 0
  476. PRINT " 7.2.-Restaurar Copia de Seguridad";
  477. COLOR 7, 4
  478. PRINT " º "
  479. LOCATE 15, 40: PRINT " ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ "
  480. LOCATE 16, 40: PRINT " º                                    º "
  481. LOCATE 17, 40: PRINT " º Pendrive...(D,E,F,G,etc):          º "
  482. LOCATE 18, 40: PRINT " º                                    º "
  483. LOCATE 19, 40: PRINT " ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ "
  484. COLOR 7, 0
  485. FOR n% = 14 TO 19
  486.     LOCATE n%, 80: PRINT " "
  487. NEXT n%
  488. LOCATE 20, 41: PRINT SPC(40);
  490. COLOR 15, 0
  491. 3010 y = 17: x = 69: a$ = "": l = 1: sp = 1: nu$ = "T"
  492. CALL rutimput(y, x, a$, l, ant, sp, nu$)
  493. IF ant = 2 THEN
  494.     PCOPY 2, 0
  495.     GOTO 1580
  497. a$ = UCASE$(a$)
  498. IF a$ <> "" THEN
  499.     disco = INSTR("DEFGHIJKLMN¥OPQRSTUVWXYZ", a$)
  500.     IF disco = 0 THEN GOTO 2660
  502.  
  503. resto$ = "CMD /C c:\almav10\mysql -v --host=" + servidor$ + " --user=" + usuario$ + " --password=" + clave$ + " --port=" + LTRIM$(STR$(puerto)) + " " + bdatos$ + " < " + a$ + ":" + "COPIA" + bdatos$ + ".sql"
  504.  
  505. COLOR 15, 0
  507. COLOR 15, 0
  509. PRINT "********************************************************************************"
  510. PRINT "***********  RESTAURANDO COPIA DE SEGURIDAD DE LA BASE DE DATOS ****************"
  511. PRINT "********************************************************************************"
  513. SHELL resto$
  514. IF _DIREXISTS(a$ + ":\ARCHIVOS") THEN
  515.     PRINT "********************************************************************************"
  516.     PRINT "********** RESTAURANDO COPIA DE SEGURIDAD DE LA CARPETA 'ARCHIVOS' *************"
  517.     PRINT "********************************************************************************"
  518.     backu$ = "CMD /C XCOPY " + a$ + ":\ARCHIVOS\*.* c:\ALMAv10\ARCHIVOS\ /Y /V /S /E"
  519.     SHELL backu$
  521.  
  522. COLOR 25, 7
  524. PRINT "                             PULSE UNA TECLA PARA CONTINUAR                     ";
  526. x$ = INPUT$(1): x$ = ""
  527. COLOR 7, 0
  528. PCOPY 2, 0
  529. GOTO 1580
  530.  
  531.  
  532. 2000 '----------------------- VENTANA DE SALIR DEL PROGRAMA --------------------
  534. COLOR 7, 4
  535. LOCATE 10, 30: PRINT " ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ» "
  536. LOCATE 11, 30: PRINT " º ";
  537. COLOR 15, 0
  538. PRINT "  <Esc> Salir del Programa.       ";
  539. COLOR 7, 4
  540. PRINT " º "
  541. LOCATE 12, 30: PRINT " ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ "
  542. LOCATE 13, 30: PRINT " º  NO SE OLVIDE DE OBTENER UNA COPIA º "
  543. LOCATE 14, 30: PRINT " º  DE  SEGURIDAD SI SE HA MODIFICADO º "
  544. LOCATE 15, 30: PRINT " º  ALGUN DATO.                       º "
  545. LOCATE 16, 30: PRINT " º                                    º "
  546. LOCATE 17, 30: PRINT " º    ¨ABANDONA EL PROGRAMA (S/N)?    º "
  547. LOCATE 18, 30: PRINT " ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ "
  548. COLOR 7, 0
  549. FOR n% = 11 TO 18
  550.     LOCATE n%, 70: PRINT " "
  551. NEXT n%
  552. LOCATE 19, 31: PRINT SPC(40);
  555.     x$ = UCASE$(INPUT$(1))
  556.     IF x$ = "S" OR x$ = "N" THEN EXIT DO
  558. IF x$ = "N" THEN PCOPY 1, 0: GOTO 500
  559. IF _FILEEXISTS("c:\ALMAv10\SERVIDOR.DAT") THEN
  560.     KILL "c:\ALMAv10\SERVIDOR.DAT"
  562. busclave$ = "UPDATE const SET controlmenu= '000' WHERE id= '1'"
  563. CALL basedato(busclave$, rows, columns)
  564. mysql_close (conn) '-- Cerrar Base de Datos
  565. COLOR 7, 0: CLS
  567.  
  568. 15000 '----------------------- RUTINA DE ERROR -------------------------------
  569. _FONT 16 'change to the QB64 default font to free it
  572. COLOR 7, 0
  574. COLOR 15, 4
  575. LOCATE 8, 23: PRINT " ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ "
  576. LOCATE 9, 23: PRINT " Û                              Û "
  577. LOCATE 10, 23: PRINT USING " Û   ERROR ### en Linea #####   Û "; ERR; _ERRORLINE 'ERL
  578. LOCATE 11, 23: PRINT " Û                              Û "
  579. LOCATE 12, 23: PRINT " Û     ­ SISTEMA PARADO !       Û "
  580. LOCATE 13, 23: PRINT " Û                              Û "
  581. LOCATE 14, 23: PRINT " Û  Pulse una tecla para volver Û "
  582. LOCATE 15, 23: PRINT " Û  a COMENZAR.                 Û "
  583. LOCATE 16, 23: PRINT " Û                              Û "
  584. LOCATE 17, 23: PRINT " ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß "
  585. COLOR 7, 0
  586. x$ = INPUT$(1)
  587. RESUME 100
  588.  
  589. 17000 '--------------------------- RELOJ ---------------------------------------
  590. COLOR 7, 1
  591. LOCATE 25, 70: PRINT TIME$;
  592. COLOR 15, 0
  594.  
  595. 32000 '----------------------- ENTRAR EN OTRO PROGRAMA -----------------------
  596. IF impresora$ <> "" THEN
  597.     SHELL _HIDE "cmd/c wmic printer where name='" + impresora$ + "' call setdefaultprinter"
  599. COLOR 7, 0, 0: CLS
  600. LOCATE 12, 20: PRINT "Procesando......"
  601. busclave$ = "UPDATE const SET controlmenu= '" + c$ + "' WHERE id= '1'"
  602. CALL basedato(busclave$, rows, columns)
  603. 32010 mysql_close (conn) '-- Cerrar Base de Datos
  604. b$ = "\ALMAv10\" + b$: CHAIN b$
  605.  
  606. '-----------------------------------------------------------------------------------------------------------------------------
  607. '----------------------------------------------------------- RUTINAS ---------------------------------------------------------
  608. '-----------------------------------------------------------------------------------------------------------------------------
  609. ' $include: 'RUTIN10v1.bas'

y las rutinas del $include

Code: QB64: [Select]
  1. DECLARE CUSTOMTYPE LIBRARY "mysql_helper"
  2.     FUNCTION offset_to_string$ ALIAS offset_to_offset (BYVAL offset AS _OFFSET)
  3.     FUNCTION offset_at_offset%& (BYVAL offset AS _OFFSET)
  5.  
  6. '#### download mysql.dll from http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/mysql.dll (~2MB) ####
  8.     FUNCTION mysql_init%& (BYVAL always_0 AS _OFFSET)
  9.     FUNCTION mysql_error$ (BYVAL mysql AS _OFFSET)
  10.     FUNCTION mysql_get_client_info$
  11.     FUNCTION mysql_real_connect%& (BYVAL mysql AS _OFFSET, host AS STRING, user AS STRING, password AS STRING, db AS STRING, BYVAL port AS _UNSIGNED LONG, BYVAL unix_socket AS _OFFSET, BYVAL client_flag AS _UNSIGNED _OFFSET)
  12.     FUNCTION mysql_real_connect_dont_open%& ALIAS mysql_real_connect (BYVAL mysql AS _OFFSET, host AS STRING, user AS STRING, password AS STRING, BYVAL db AS _OFFSET, BYVAL port AS _UNSIGNED LONG, BYVAL unix_socket AS _OFFSET, BYVAL client_flag AS _UNSIGNED LONG)
  13.     SUB mysql_query (BYVAL mysql AS _OFFSET, mysql_command AS STRING)
  14.     FUNCTION mysql_query& (BYVAL mysql AS _OFFSET, mysql_command AS STRING)
  15.     FUNCTION mysql_store_result%& (BYVAL mysql AS _OFFSET)
  16.     FUNCTION mysql_num_fields~& (BYVAL result AS _OFFSET)
  17.     FUNCTION mysql_num_rows&& (BYVAL result AS _OFFSET)
  18.     FUNCTION mysql_fetch_row%& (BYVAL result AS _OFFSET)
  19.     FUNCTION mysql_fetch_lengths%& (BYVAL result AS _OFFSET)
  20.     SUB mysql_close (BYVAL mysql AS _OFFSET)
  21.     SUB mysql_free_result (BYVAL result AS _OFFSET)
  23.  
  24.  
  25. '----------------------------------------------------------- MYSQL -----------------------------------------------------------
  26. SUB basedato (busclave$, rows, columns)
  27.     '*** Hacer busqueda en la tabla ***
  28.     errf = mysql_query(conn, busclave$)
  29.     DIM result AS _OFFSET
  30.     'DIM columns AS LONG
  31.     result = mysql_store_result(conn)
  32.     IF LEFT$(busclave$, 6) = "SELECT" THEN
  33.         'DIM row AS _OFFSET
  34.         'DIM dato AS _OFFSET
  35.         columns = mysql_num_fields(result)
  36.         rows = mysql_num_rows(result)
  37.         '*** Guardar en Array ***
  38.         REDIM DB_RESULT(columns, rows) AS STRING
  39.         FOR filas = 1 TO rows
  40.             DIM mysql_row AS _OFFSET
  41.             mysql_row = mysql_fetch_row(result)
  42.             DIM mem_mysql_row AS _MEM
  43.             mem_mysql_row = _MEM(mysql_row, columns * LEN(an_offset%&)) 'The upper limit is unknown at this point
  44.             DIM mysql_lengths AS _OFFSET
  45.             mysql_lengths = mysql_fetch_lengths(result)
  46.             DIM mem_mysql_lengths AS _MEM
  47.             mem_mysql_lengths = _MEM(mysql_lengths, columns * 4)
  48.             DIM mem_field AS _MEM
  49.             FOR campos = 1 TO columns
  50.                 length = _MEMGET(mem_mysql_lengths, mem_mysql_lengths.OFFSET + (campos - 1) * 4, _UNSIGNED LONG)
  51.                 mem_field = _MEM(_MEMGET(mem_mysql_row, mem_mysql_row.OFFSET + (campos - 1) * LEN(an_offset%&), _OFFSET), length)
  52.                 DB_RESULT(campos, filas) = SPACE$(length)
  53.                 _MEMGET mem_field, mem_field.OFFSET, DB_RESULT(campos, filas)
  54.                 _MEMFREE mem_field
  55.             NEXT
  56.             _MEMFREE mem_mysql_lengths
  57.             _MEMFREE mem_mysql_row
  58.         NEXT
  59.     END IF
  60.     mysql_free_result result
  62.  
  63. SUB calcif (a$)
  64.     '------------------- CALCULAR LETRA CIF -------------------------------
  65.     IF LEN(a$) < 9 THEN
  66.         DIM cif$(24)
  67.         cif$(1) = "03A": cif$(2) = "11B": cif$(3) = "20C": cif$(4) = "09D"
  68.         cif$(5) = "22E": cif$(6) = "07F": cif$(7) = "04G": cif$(8) = "18H"
  69.         cif$(9) = "13J": cif$(10) = "21K": cif$(11) = "19L": cif$(12) = "05M"
  70.         cif$(13) = "12N": cif$(14) = "08P": cif$(15) = "16Q": cif$(16) = "01R"
  71.         cif$(17) = "15S": cif$(18) = "00T": cif$(19) = "23T": cif$(20) = "17V"
  72.         cif$(21) = "02W": cif$(22) = "10X": cif$(23) = "06Y": cif$(24) = "14Z"
  73.         a# = VAL(a$): b# = a# / 23: c# = INT(b#) * 23: d = a# - c#
  74.         FOR m = 1 TO 24
  75.             IF VAL(LEFT$(cif$(m), 2)) = d THEN
  76.                 a$ = a$ + RIGHT$(cif$(m), 1): EXIT FOR
  77.             END IF
  78.         NEXT m
  79.     END IF
  81.  
  82. SUB calcu (a$)
  83.     '----------- CALCULADORA ----------------------------------------------------
  84.     PCOPY 0, 3
  85.     DIM calcures$(16)
  86.     FOR ncalcures% = 1 TO 14: calcures$(ncalcures%) = STRING$(16, "°"): NEXT
  87.     calcures$(15) = SPACE$(16): calcures$(16) = SPACE$(16)
  88.     a$ = "": b# = 0: memo# = 0: tip$ = "="
  89.     COLOR 1, 7
  90.     LOCATE 2, 2: PRINT "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
  91.     LOCATE 3, 2: PRINT "ºÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ºÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿º"
  92.     LOCATE 4, 2: PRINT "º³                ³º³               ³º"
  93.     LOCATE 5, 2: PRINT "º³                ³ºÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙº"
  94.     LOCATE 6, 2: PRINT "º³                ³º                 º"
  95.     LOCATE 7, 2: PRINT "º³                ³º                 º"
  96.     LOCATE 8, 2: PRINT "º³                ³º                 º"
  97.     LOCATE 9, 2: PRINT "º³                ³º                 º"
  98.     LOCATE 10, 2: PRINT "º³                ³º                 º"
  99.     LOCATE 11, 2: PRINT "º³                ³º                 º"
  100.     LOCATE 12, 2: PRINT "º³                ³º                 º"
  101.     LOCATE 13, 2: PRINT "º³                ³º                 º"
  102.     LOCATE 14, 2: PRINT "º³                ³º                 º"
  103.     LOCATE 15, 2: PRINT "º³                ³º                 º"
  104.     LOCATE 16, 2: PRINT "º³                ³º                 º"
  105.     LOCATE 17, 2: PRINT "º³                ³º                 º"
  106.     LOCATE 18, 2: PRINT "º³                ³º                 º"
  107.     LOCATE 19, 2: PRINT "º³                ³º                 º"
  108.     LOCATE 20, 2: PRINT "ºÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙº                 º"
  109.     LOCATE 21, 2: PRINT "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ"
  110.     COLOR 7, 1
  111.     LOCATE 6, 29: PRINT "ÚÄ¿ÚÄ¿ÚÄ¿"
  112.     LOCATE 7, 29: PRINT "³/³³*³³-³"
  113.     LOCATE 8, 29: PRINT "ÀÄÙÀÄÙÀÄÙ"
  114.     LOCATE 9, 23: COLOR 7, 4: PRINT "ÚÄ¿";: COLOR 7, 0: PRINT "ÚÄ¿ÚÄ¿ÚÄ¿";: COLOR 7, 1: PRINT "ÚÄ¿"
  115.     LOCATE 10, 23: COLOR 7, 4: PRINT "³C³";: COLOR 7, 0: PRINT "³7³³8³³9³";: COLOR 7, 1: PRINT "³ ³"
  116.     LOCATE 11, 23: COLOR 7, 4: PRINT "ÀÄÙ";: COLOR 7, 0: PRINT "ÀÄÙÀÄÙÀÄÙ";: COLOR 7, 1: PRINT "³+³"
  117.     LOCATE 12, 23: COLOR 7, 4: PRINT "ÚÄ¿";: COLOR 7, 0: PRINT "ÚÄ¿ÚÄ¿ÚÄ¿";: COLOR 7, 1: PRINT "³ ³"
  118.     LOCATE 13, 23: COLOR 7, 4: PRINT "³E³";: COLOR 7, 0: PRINT "³4³³5³³6³";: COLOR 7, 1: PRINT "³ ³"
  119.     LOCATE 14, 23: COLOR 7, 4: PRINT "ÀÄÙ";: COLOR 7, 0: PRINT "ÀÄÙÀÄÙÀÄÙ";: COLOR 7, 1: PRINT "ÀÄÙ"
  120.     LOCATE 15, 23: COLOR 7, 1: PRINT "ÚÄ¿";: COLOR 7, 0: PRINT "ÚÄ¿ÚÄ¿ÚÄ¿";: COLOR 7, 1: PRINT "ÚÄ¿"
  121.     LOCATE 16, 23: COLOR 7, 1: PRINT "³T³";: COLOR 7, 0: PRINT "³1³³2³³3³";: COLOR 7, 1: PRINT "³ ³"
  122.     LOCATE 17, 23: COLOR 7, 1: PRINT "³r³";: COLOR 7, 0: PRINT "ÀÄÙÀÄÙÀÄÙ";: COLOR 7, 1: PRINT "³=³"
  123.     LOCATE 18, 23: COLOR 7, 1: PRINT "³a³";: COLOR 7, 0: PRINT "ÚÄÄÄÄ¿ÚÄ¿";: COLOR 7, 1: PRINT "³ ³"
  124.     LOCATE 19, 23: COLOR 7, 1: PRINT "³n³";: COLOR 7, 0: PRINT "³  0 ³³.³";: COLOR 7, 1: PRINT "³ ³"
  125.     LOCATE 20, 23: COLOR 7, 1: PRINT "ÀÄÙ";: COLOR 7, 0: PRINT "ÀÄÄÄÄÙÀÄÙ";: COLOR 7, 1: PRINT "ÀÄÙ"
  126.     COLOR 1, 7
  127.     LOCATE 3, 3: PRINT "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"
  128.     FOR n = 4 TO 19
  129.         LOCATE n, 3: PRINT "³"; STRING$(16, "°"); "³"
  130.     NEXT n
  131.     LOCATE 20, 3: PRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"
  132.     COLOR 10, 0
  133.     DO
  134.         LOCATE 4, 23: PRINT USING "###,###,###.##"; VAL(a$);: PRINT tip$
  135.        10 x$ = "": WHILE x$ = "": x$ = INKEY$: WEND
  136.         IF ASC(x$) = 27 THEN
  137.             a$ = ""
  138.             PCOPY 3, 0
  139.             COLOR 15, 0: EXIT SUB
  140.         END IF
  141.         IF ASC(x$) = 13 OR x$ = "*" OR x$ = "/" OR x$ = "+" OR x$ = "-" THEN GOSUB opera: GOTO 10
  142.         IF x$ = "T" OR x$ = "t" THEN
  143.             a$ = LTRIM$(STR$(INT(b# * 100) / 100))
  144.             PCOPY 3, 0
  145.             COLOR 15, 0
  146.             EXIT SUB
  147.         END IF
  148.         IF x$ = "E" OR x$ = "e" THEN
  149.             a$ = ""
  150.         ELSE
  151.             IF x$ = "C" OR x$ = "c" THEN
  152.                 b# = 0: a$ = "": tip$ = "="
  153.                 GOSUB imprime
  154.             ELSE
  155.                 IF LEN(a$) < 9 THEN
  156.                     c$ = a$: a$ = x$: CALL nonum(a$, bien): a$ = c$
  157.                     IF bien <> 0 THEN
  158.                         a$ = a$ + x$
  159.                     END IF
  160.                 END IF
  161.             END IF
  162.         END IF
  163.     LOOP
  164.  
  165.     opera:
  166.     SELECT CASE tip$
  167.         CASE "="
  168.             IF memo# <> 0 AND a$ = "" THEN
  169.                 b# = memo#: memo# = 0
  170.             ELSE
  171.                 b# = VAL(a$)
  172.             END IF
  173.         CASE "+"
  174.             IF LEN(a$) <> 0 THEN b# = b# + VAL(a$)
  175.         CASE "-"
  176.             IF LEN(a$) <> 0 THEN b# = b# - VAL(a$)
  177.         CASE "*"
  178.             IF LEN(a$) <> 0 THEN b# = b# * VAL(a$)
  179.         CASE "/"
  180.             IF VAL(a$) <> 0 THEN b# = INT(b# * 100 / VAL(a$)) / 100 ELSE b# = 0: tip$ = "=": memo# = 0: LOCATE 3, 22: PRINT "Desbordamiento": GOSUB imprime: GOTO 40
  181.     END SELECT
  182.     tip$ = x$
  183.     IF x$ = CHR$(13) THEN tip$ = "=": memo# = b#
  184.     IF b# > 999999999.99# THEN
  185.         b# = 0: tip$ = "=": memo# = 0: LOCATE 4, 23: PRINT "Desbordamiento"
  186.         GOSUB imprime: GOTO 40
  187.     ELSE
  188.         LOCATE 4, 23: PRINT USING "###,###,###.##"; b#;: PRINT tip$
  189.         GOSUB imprime
  190.     END IF
  191.    40 a$ = ""
  192.     RETURN
  193.  
  194.     imprime:
  195.     COLOR 0, 7
  196.     FOR ncalcures% = 1 TO 15
  197.         SWAP calcures$(ncalcures%), calcures$(ncalcures% + 1)
  198.     NEXT
  199.     IF LEN(a$) <> 0 THEN
  200.         CALL converprin(a$, 14)
  201.         calcures$(16) = a$ + " " + tip$
  202.     ELSE
  203.         a$ = LTRIM$(STR$(b#))
  204.         CALL converprin(a$, 14)
  205.         calcures$(16) = a$ + " " + tip$
  206.     END IF
  207.     'CALL scroll(tipo$, nlin, y1, x1, y2, x2, colo)
  208.     'LOCATE 19, 4: PRINT " Û              "
  209.     IF tip$ = "=" THEN
  210.         FOR ncalcures% = 1 TO 14
  211.             SWAP calcures$(ncalcures%), calcures$(ncalcures% + 2)
  212.         NEXT
  213.         a$ = LTRIM$(STR$(b#))
  214.         CALL converprin(a$, 14)
  215.         calcures$(15) = a$ + " T"
  216.         calcures$(16) = SPACE$(16)
  217.     END IF
  218.     FOR ncalcures% = 1 TO 16
  219.         IF calcures$(ncalcures%) = STRING$(16, "°") THEN
  220.             COLOR 1, 7
  221.         ELSE
  222.             IF MID$(calcures$(ncalcures%), 16, 1) <> "T" THEN COLOR 0, 7 ELSE COLOR 4, 7
  223.         END IF
  224.         LOCATE ncalcures% + 3, 4: PRINT calcures$(ncalcures%)
  225.     NEXT
  226.     COLOR 10, 0
  227.     RETURN
  228.  
  230.  
  231. SUB colpos (y, x, colo1, colo2)
  232.     '-------------------------------- OBTENER COLOR DE FONDO Y TEXTO DE UNA POSICION DE PANTALLA ---------------------------
  233.     b = (y - 1) * 160 + (x - 1) * 2 + 1
  234.     DEF SEG = VAL("&HB800")
  235.     a = PEEK(b)
  236.     DEF SEG
  237.     a$ = ""
  238.     FOR n = 1 TO 8
  239.         b = a / 2: c = INT(a / 2)
  240.         IF c <> b THEN a$ = "1" + a$ ELSE a$ = "0" + a$
  241.         a = c
  242.     NEXT n
  243.     colo1 = 0 - 1 * (VAL(MID$(a$, 8, 1)) = 1) - 2 * (VAL(MID$(a$, 7, 1)) = 1) - 4 * (VAL(MID$(a$, 6, 1)) = 1) - 8 * (VAL(MID$(a$, 5, 1)) = 1) - 16 * (VAL(MID$(a$, 1, 1)) = 1)
  244.     colo2 = 0 - 1 * (VAL(MID$(a$, 4, 1)) = 1) - 2 * (VAL(MID$(a$, 3, 1)) = 1) - 4 * (VAL(MID$(a$, 2, 1)) = 1)
  246.  
  247. SUB comfecha (a$)
  248.     '------------------------ COMPROBAR FECHA REAL -------------------------------
  249.     CALL nonum(a$, bien): IF bien = 0 THEN EXIT SUB
  250.     IF INSTR(a$, ".") <> 0 OR INSTR(a$, "-") <> 0 THEN a$ = "": EXIT SUB
  251.     IF LEN(a$) < 6 THEN a$ = "": EXIT SUB
  252.     aa = VAL(RIGHT$(a$, 2))
  253.     IF aa < 4 THEN
  254.         IF aa = 0 THEN bis = 1 ELSE bis = 0: '--- a¤o 2001 al 2003
  255.     ELSE
  256.         bis = 0: IF INT(aa / 4) = (aa / 4) THEN bis = 1
  257.     END IF
  258.     mm = VAL(MID$(a$, 3, 2)): IF mm < 1 OR mm > 12 THEN a$ = "": EXIT SUB
  259.     dd = VAL(LEFT$(a$, 2)): IF dd < 1 OR dd > 31 THEN a$ = "": EXIT SUB
  260.     IF dd > 28 AND mm = 2 AND bis = 0 THEN a$ = "": EXIT SUB
  261.     IF dd > 29 AND mm = 2 THEN a$ = "": EXIT SUB
  262.     IF (mm = 4 OR mm = 6 OR mm = 9 OR mm = 11) AND dd > 30 THEN
  263.         a$ = "": EXIT SUB
  264.     END IF
  266.  
  267. SUB convercero (a$, b)
  268.     '------------------------------- CONVERTIR EN CADENA CON CEROS A LA IZQUIERDA Y 2 DECIMALES ---------------------------------------
  269.     IF VAL(a$) <> 0 THEN
  270.         IF VAL(a$) < 100000 THEN
  271.             c = VAL(a$)
  272.             d = c * 100 + .5
  273.             a = INT(d)
  274.             a$ = LTRIM$(STR$(a))
  275.         ELSE
  276.             c# = VAL(a$)
  277.             d# = c# * 100 + .5
  278.             a# = INT(d#)
  279.             a$ = LTRIM$(STR$(a#))
  280.         END IF
  281.         IF LEN(a$) = 1 THEN
  282.             a$ = "0.0" + a$
  283.         ELSEIF LEN(a$) = 2 THEN
  284.             IF VAL(a$) < 0 THEN
  285.                 a$ = "-0.0" + RIGHT$(a$, 1)
  286.             ELSE
  287.                 a$ = "0." + a$
  288.             END IF
  289.         ELSEIF LEN(a$) = 3 AND VAL(a$) < 0 THEN
  290.             a$ = "-0." + RIGHT$(a$, 2)
  291.         ELSE
  292.             a$ = LEFT$(a$, LEN(a$) - 2) + "." + RIGHT$(a$, 2)
  293.         END IF
  294.     ELSE
  295.         a$ = "0.00"
  296.     END IF
  297.     a = b - LEN(a$)
  298.     IF a > 0 THEN
  299.         a$ = STRING$(a, "0") + a$
  300.     END IF
  302.  
  303. SUB convertir (a$, b)
  304.     '----------------------------------------- CONVERTIR EN CADENA CON ESPACIOS A LA IZQUIERDA Y 2 DECIMALES -----------------------
  305.     IF VAL(a$) <> 0 THEN
  306.         IF VAL(a$) < 100000 THEN
  307.             c = VAL(a$)
  308.             d = c * 100 + .5
  309.             a = INT(d)
  310.             a$ = LTRIM$(STR$(a))
  311.         ELSE
  312.             c# = VAL(a$)
  313.             d# = c# * 100 + .5
  314.             a# = INT(d#)
  315.             a$ = LTRIM$(STR$(a#))
  316.         END IF
  317.         IF LEN(a$) = 1 THEN
  318.             a$ = "0.0" + a$
  319.         ELSEIF LEN(a$) = 2 THEN
  320.             IF VAL(a$) < 0 THEN
  321.                 a$ = "-0.0" + RIGHT$(a$, 1)
  322.             ELSE
  323.                 a$ = "0." + a$
  324.             END IF
  325.         ELSEIF LEN(a$) = 3 AND VAL(a$) < 0 THEN
  326.             a$ = "-0." + RIGHT$(a$, 2)
  327.         ELSE
  328.             a$ = LEFT$(a$, LEN(a$) - 2) + "." + RIGHT$(a$, 2)
  329.         END IF
  330.     ELSE
  331.         a$ = "0.00"
  332.     END IF
  333.     a = b - LEN(a$)
  334.     IF a > 0 THEN
  335.         a$ = SPACE$(a) + a$
  336.     END IF
  338.  
  339. SUB converprin (a$, b)
  340.     '----------------------------------------- CONVERTIR NUMERO CON SEPARADORES DE MILES  Y 2 DECIMALES -----------------------
  341.     IF VAL(a$) <> 0 THEN
  342.         c# = VAL(a$)
  343.         d# = c# * 100 + .5
  344.         a# = INT(d#)
  345.         a$ = LTRIM$(STR$(a#))
  346.         IF LEN(a$) = 1 THEN
  347.             a$ = "0.0" + a$
  348.         ELSEIF LEN(a$) = 2 THEN
  349.             IF VAL(a$) < 0 THEN
  350.                 a$ = "-0.0" + RIGHT$(a$, 1)
  351.             ELSE
  352.                 a$ = "0." + a$
  353.             END IF
  354.         ELSEIF LEN(a$) = 3 AND VAL(a$) < 0 THEN
  355.             a$ = "-0." + RIGHT$(a$, 2)
  356.         ELSE
  357.             a$ = LEFT$(a$, LEN(a$) - 2) + "." + RIGHT$(a$, 2)
  358.         END IF
  359.     ELSE
  360.         a$ = "0.00"
  361.     END IF
  362.     a = b - LEN(a$)
  363.     IF a > 0 THEN
  364.         a$ = SPACE$(a) + a$
  365.     END IF
  366.     IF LEN(a$) - 6 > 0 THEN
  367.         IF MID$(a$, LEN(a$) - 6, 1) <> " " AND MID$(a$, LEN(a$) - 6, 1) <> "-" THEN
  368.             a$ = LEFT$(a$, LEN(a$) - 6) + "," + MID$(a$, LEN(a$) - 5)
  369.             a$ = MID$(a$, 2): '--para quitar caracter que se ha generado por meter la coma
  370.         END IF
  371.     END IF
  372.     IF LEN(a$) - 10 > 0 THEN
  373.         IF MID$(a$, LEN(a$) - 10, 1) <> " " AND MID$(a$, LEN(a$) - 10, 1) <> "-" THEN
  374.             a$ = LEFT$(a$, LEN(a$) - 10) + "," + MID$(a$, LEN(a$) - 9)
  375.             a$ = MID$(a$, 2): '--para quitar caracter que se ha generado por meter la coma
  376.         END IF
  377.     END IF
  378.     IF LEN(a$) - 14 > 0 THEN
  379.         IF MID$(a$, LEN(a$) - 14, 1) <> " " AND MID$(a$, LEN(a$) - 14, 1) <> "-" THEN
  380.             a$ = LEFT$(a$, LEN(a$) - 14) + "," + MID$(a$, LEN(a$) - 13)
  381.             a$ = MID$(a$, 2): '--para quitar caracter que se ha generado por meter la coma
  382.         END IF
  383.     END IF
  385.  
  386. SUB converprin3 (a$, b)
  387.     '----------------------------------------- CONVERTIR NUMERO CON SEPARADORES DE MILES  Y 3 DECIMALES -----------------------
  388.     IF VAL(a$) <> 0 THEN
  389.         c# = VAL(a$)
  390.         d# = c# * 1000 + .5
  391.         a# = INT(d#)
  392.         a$ = LTRIM$(STR$(a#))
  393.         IF LEN(a$) = 1 THEN
  394.             a$ = "0.00" + a$
  395.         ELSEIF LEN(a$) = 2 THEN
  396.             IF VAL(a$) < 0 THEN
  397.                 a$ = "-0.00" + RIGHT$(a$, 1)
  398.             ELSE
  399.                 a$ = "0.0" + a$
  400.             END IF
  401.         ELSEIF LEN(a$) = 3 THEN
  402.             IF VAL(a$) < 0 THEN
  403.                 a$ = "-0.0" + RIGHT$(a$, 2)
  404.             ELSE
  405.                 a$ = "0." + RIGHT$(a$, 3)
  406.             END IF
  407.         ELSEIF LEN(a$) = 4 AND VAL(a$) < 0 THEN
  408.             a$ = "-0." + RIGHT$(a$, 3)
  409.         ELSE
  410.             a$ = LEFT$(a$, LEN(a$) - 3) + "." + RIGHT$(a$, 3)
  411.         END IF
  412.     ELSE
  413.         a$ = "0.000"
  414.     END IF
  415.     a = b - LEN(a$)
  416.     IF a > 0 THEN
  417.         a$ = SPACE$(a) + a$
  418.     END IF
  419.     IF LEN(a$) - 7 > 0 THEN
  420.         IF MID$(a$, LEN(a$) - 7, 1) <> " " AND MID$(a$, LEN(a$) - 7, 1) <> "-" THEN
  421.             a$ = LEFT$(a$, LEN(a$) - 7) + "," + MID$(a$, LEN(a$) - 6)
  422.             a$ = MID$(a$, 2): '--para quitar caracter que se ha generado por meter la coma
  423.         END IF
  424.     END IF
  425.     IF LEN(a$) - 11 > 0 THEN
  426.         IF MID$(a$, LEN(a$) - 11, 1) <> " " AND MID$(a$, LEN(a$) - 11, 1) <> "-" THEN
  427.             a$ = LEFT$(a$, LEN(a$) - 11) + "," + MID$(a$, LEN(a$) - 10)
  428.             a$ = MID$(a$, 2): '--para quitar caracter que se ha generado por meter la coma
  429.         END IF
  430.     END IF
  431.     IF LEN(a$) - 15 > 0 THEN
  432.         IF MID$(a$, LEN(a$) - 15, 1) <> " " AND MID$(a$, LEN(a$) - 15, 1) <> "-" THEN
  433.             a$ = LEFT$(a$, LEN(a$) - 15) + "," + MID$(a$, LEN(a$) - 14)
  434.             a$ = MID$(a$, 2): '--para quitar caracter que se ha generado por meter la coma
  435.         END IF
  436.     END IF
  438.  
  439. SUB converprinentero (a$, b)
  440.     '----------------------------------------- CONVERTIR NUMERO ENTERO CON SEPARADORES DE MILES -----------------------
  441.     a = b - LEN(a$)
  442.     IF a > 0 THEN
  443.         a$ = SPACE$(a) + a$
  444.     END IF
  445.     IF LEN(a$) - 3 > 0 THEN
  446.         IF MID$(a$, LEN(a$) - 3, 1) <> " " AND MID$(a$, LEN(a$) - 3, 1) <> "-" THEN
  447.             a$ = LEFT$(a$, LEN(a$) - 3) + "," + MID$(a$, LEN(a$) - 2)
  448.             a$ = MID$(a$, 2): '--para quitar caracter que se ha generado por meter la coma
  449.         END IF
  450.     END IF
  451.     IF LEN(a$) - 7 > 0 THEN
  452.         IF MID$(a$, LEN(a$) - 7, 1) <> " " AND MID$(a$, LEN(a$) - 7, 1) <> "-" THEN
  453.             a$ = LEFT$(a$, LEN(a$) - 7) + "," + MID$(a$, LEN(a$) - 6)
  454.             a$ = MID$(a$, 2): '--para quitar caracter que se ha generado por meter la coma
  455.         END IF
  456.     END IF
  457.     IF LEN(a$) - 11 > 0 THEN
  458.         IF MID$(a$, LEN(a$) - 11, 1) <> " " AND MID$(a$, LEN(a$) - 11, 1) <> "-" THEN
  459.             a$ = LEFT$(a$, LEN(a$) - 11) + "," + MID$(a$, LEN(a$) - 10)
  460.             a$ = MID$(a$, 2): '--para quitar caracter que se ha generado por meter la coma
  461.         END IF
  462.     END IF
  464.  
  465. SUB nonum (a$, bien)
  466.     '------------------------ COMPROBAR SI ES UN NUMERO --------------------------
  467.     FOR c = 1 TO LEN(a$)
  468.         IF ASC(MID$(a$, c)) < 45 OR ASC(MID$(a$, c)) > 57 THEN
  469.             bien = 0: a$ = "": EXIT SUB
  470.         END IF
  471.     NEXT c
  472.     z = INSTR(a$, "-")
  473.     IF z <> 0 AND z <> 1 THEN bien = 0: a$ = "": EXIT SUB
  474.     IF z = 1 THEN
  475.         z = INSTR(2, a$, "-")
  476.         IF z <> 0 THEN a$ = "": bien = 0: EXIT SUB
  477.     END IF
  478.     z = INSTR(a$, ".")
  479.     IF z <> 0 THEN
  480.         z = INSTR(z + 1, a$, ".")
  481.         IF z <> 0 THEN a$ = "": bien = 0: EXIT SUB
  482.     END IF
  483.     bien = 1: EXIT SUB
  485.  
  486.  
  487. SUB rutimput (y, x, a$, l, ant, sp, nu$)
  488.     '----------------------- ENTRADA DE DATOS DESDE TECLADO ---------------------
  489.     ant = 0: c = LEN(a$): control = 0: LOCATE y, x: PRINT SPC(sp);
  490.     DO
  491.         IF INSTR(nu$, "F") THEN
  492.             LOCATE y, x: PRINT "../../..";
  493.             LOCATE y, x
  494.             FOR longi = 1 TO LEN(a$)
  495.                 IF longi = 3 OR longi = 5 THEN PRINT "/";
  496.                 PRINT MID$(a$, longi, 1);
  497.             NEXT
  498.         ELSE
  499.             LOCATE y, x: PRINT STRING$(l, ".");: LOCATE y, x: PRINT a$;
  500.         END IF
  501.         x$ = ""
  502.         WHILE x$ = ""
  503.             IF INSTR(nu$, "F") THEN
  504.                 IF c = 2 OR c = 3 THEN
  505.                     LOCATE y, x + c + 1, 1
  506.                 END IF
  507.                 IF c = 4 OR c = 5 THEN
  508.                     LOCATE y, x + c + 2, 1
  509.                 END IF
  510.                 IF c = 1 OR c = 0 THEN
  511.                     LOCATE y, x + c, 1
  512.                 END IF
  513.             ELSE
  514.                 LOCATE y, x + c, 1
  515.             END IF
  516.             x$ = INKEY$
  517.         WEND
  518.        2 IF LEN(x$) = 1 THEN
  519.             SELECT CASE ASC(x$)
  520.                 CASE 13
  521.                     EXIT SUB
  522.                 CASE 8
  523.                     SELECT CASE c
  524.                         CASE 0
  525.                             '--BEEP
  526.                         CASE 1
  527.                             a$ = MID$(a$, 2, LEN(a$) - 1): c = c - 1
  528.                             LOCATE y, x: PRINT a$ + ".";
  529.                         CASE ELSE
  530.                             a$ = LEFT$(a$, c - 1) + MID$(a$, c + 1, LEN(a$) - c)
  531.                             c = c - 1: LOCATE y, x: PRINT a$ + ".";
  532.                     END SELECT
  533.                 CASE 27
  534.                     ant = 2: a$ = "": LOCATE y, x: PRINT SPC(sp);: EXIT SUB
  535.                 CASE ELSE
  536.                     IF INSTR(nu$, "T") = 0 AND INSTR("1234567890.-", x$) = 0 THEN
  537.                         '--BEEP
  538.                     ELSE
  539.                         IF INSTR(nu$, "E") AND x$ = "." THEN
  540.                             '--BEEP
  541.                         ELSE
  542.                             IF INSTR(nu$, "P") AND x$ = "-" THEN
  543.                                 '--BEEP
  544.                             ELSE
  545.                                 IF INSTR(nu$, "T") = 0 AND x$ = "-" AND c <> 0 THEN
  546.                                     '--BEEP
  547.                                 ELSE
  548.                                     IF INSTR(nu$, "T") = 0 AND x$ = "." AND INSTR(a$, ".") THEN
  549.                                         '--BEEP
  550.                                     ELSE
  551.                                         IF ASC(x$) = 241 THEN x$ = CHR$(164) 'para convertir la ¤
  552.                                         IF INSTR(nu$, "m") = 0 THEN
  553.                                             IF x$ = "¤" THEN x$ = "¥"
  554.                                             x$ = UCASE$(x$)
  555.                                         END IF
  556.                                         c = c + 1
  557.                                         IF c > l THEN
  558.                                             c = c - 1
  559.                                         ELSE
  560.                                             IF LEN(a$) = l AND control = 1 THEN
  561.                                                 c = c - 1
  562.                                             ELSE
  563.                                                 IF control = 0 THEN
  564.                                                     IF c = LEN(a$) + 1 THEN
  565.                                                         a$ = a$ + x$
  566.                                                     ELSE
  567.                                                         MID$(a$, c, 1) = x$
  568.                                                     END IF
  569.                                                 ELSE
  570.                                                     a$ = LEFT$(a$, c - 1) + x$ + RIGHT$(a$, LEN(a$) - c + 1)
  571.                                                 END IF
  572.                                                 IF INSTR(nu$, "F") THEN
  573.                                                     FOR longi = 1 TO LEN(a$)
  574.                                                         LOCATE y, x
  575.                                                         IF longi = 3 OR longi = 5 THEN PRINT "/";
  576.                                                         PRINT MID$(a$, longi, 1);
  577.                                                     NEXT
  578.                                                 ELSE
  579.                                                     LOCATE y, x: PRINT a$;
  580.                                                 END IF
  581.                                             END IF
  582.                                         END IF
  583.                                     END IF
  584.                                 END IF
  585.                             END IF
  586.                         END IF
  587.                     END IF
  588.             END SELECT
  589.         ELSE
  590.             z = ASC(RIGHT$(x$, 1))
  591.             SELECT CASE z
  592.                 CASE 59
  593.                     CALL calcu(a$)
  594.                     c = LEN(a$)
  595.                     CALL colpos(y, x, colo1, colo2)
  596.                     COLOR colo1, colo2
  597.  
  598.                 CASE 75
  599.                     control = 0
  600.                     IF c = 0 THEN
  601.                         '--BEEP
  602.                     ELSE
  603.                         c = c - 1
  604.                     END IF
  605.                 CASE 77
  606.                     control = 0
  607.                     IF c = LEN(a$) THEN
  608.                         '--BEEP
  609.                     ELSE
  610.                         c = c + 1
  611.                     END IF
  612.                 CASE 72
  613.                     ant = 1: a$ = "": LOCATE y, x: PRINT SPC(sp);: EXIT SUB
  614.                 CASE 80
  615.                     ant = z: a$ = "": LOCATE y, x: PRINT SPC(sp);: EXIT SUB
  616.                 CASE 82
  617.                     IF control = 0 AND c <> LEN(a$) THEN
  618.                         control = 1
  619.                     ELSE
  620.                         control = 0
  621.                     END IF
  622.                 CASE 83
  623.                     a$ = "": c = 0
  624.                 CASE 59 TO 68
  625.                     ant = z: a$ = "": LOCATE y, x: PRINT SPC(sp);: EXIT SUB
  626.                 CASE 121
  627.                     '--para evitar error de teclado con la arroba
  628.                     x$ = CHR$(64): GOTO 2
  629.                 CASE ELSE
  630.                     '--BEEP
  631.             END SELECT
  632.         END IF
  633.     LOOP
  634.     IF INSTR(nu$, "m") = 0 THEN
  635.         a$ = UCASE$(a$)
  636.     END IF
  638.  
  639. SUB buscacli2 (a$)
  640.     '------------------------- BUSCAR CLIENTE POR NOMBRE ----------------------------
  641.     PCOPY 0, 2
  642.     REDIM DB_RESULT(columns, rows) AS STRING
  643.     COLOR 7, 1
  644.     LOCATE 25, 1: PRINT SPACE$(80);
  645.     COLOR 1, 7
  646.     bus = 2
  647.     LOCATE 4, 10: PRINT " ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍ Busqueda de Clientes Por Apodo    ÍÍÍÍÍÍÍÍÍÍÍÍÍÍ» "
  648.     LOCATE 5, 10: PRINT " º                                                               º "
  649.     LOCATE 6, 10: PRINT " º                                                               º "
  650.     LOCATE 7, 10: PRINT " º                                                               º "
  651.     LOCATE 8, 10: PRINT " º                                                               º "
  652.     LOCATE 9, 10: PRINT " º                    *Texto=Busqueda generica                   º "
  653.     LOCATE 10, 10: PRINT " ÈÍÍÍÍÍÍÍÍÍÍÍ <F4> Cambiar busqueda ÍÍÍÍÍÍÍÍÍÍ <Esc> ÍÍÍÍÍÍÍÍÍÍÍͼ "
  654.     DO
  655.         si = 0
  656.         IF bus = 1 THEN
  657.             y = 7: x = 13: a$ = "": l = 40: sp = 40: nu$ = "T"
  658.         ELSE
  659.             y = 7: x = 13: a$ = "": l = 15: sp = 40: nu$ = "T"
  660.         END IF
  661.         CALL rutimput(y, x, a$, l, ant, sp, nu$)
  662.         IF ant = 2 THEN a$ = "@": fin = 1: EXIT DO
  663.         IF ant = 62 THEN
  664.             IF bus = 1 THEN
  665.                 bus = 2
  666.                 LOCATE 4, 10: PRINT " ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍ Busqueda de Clientes Por Apodo    ÍÍÍÍÍÍÍÍÍÍÍÍÍÍ» "
  667.             ELSE
  668.                 IF bus = 2 THEN
  669.                     bus = 1
  670.                     LOCATE 4, 10: PRINT " ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍ Busqueda de Clientes Por Apellido ÍÍÍÍÍÍÍÍÍÍÍÍÍÍ» "
  671.                 END IF
  672.             END IF
  673.         END IF
  674.         IF a$ <> "" THEN
  675.             IF LEFT$(a$, 1) <> "*" THEN
  676.                 '--busqueda por iniciales
  677.                 IF bus = 1 THEN
  678.                     busclave$ = "SELECT apodo, nombre, codigo FROM cliente WHERE nombre LIKE '" + a$ + "%'" + CHR$(0)
  679.                 ELSE
  680.                     busclave$ = "SELECT apodo, nombre, codigo FROM cliente WHERE apodo LIKE '" + a$ + "%'" + CHR$(0)
  681.                 END IF
  682.                 CALL basedato(busclave$, rows, columns)
  683.                 IF rows <> 0 THEN
  684.                     LOCATE 10, 10: PRINT " ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ<" + CHR$(24) + ">ÍÍÍÍÍÍÍÍÍ<" + CHR$(25) + ">ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ "
  685.                     COLOR 0, 7
  686.                     EXIT DO
  687.                 END IF
  688.             ELSE
  689.                 IF LEN(a$) = 1 THEN
  690.                     '--busqueda de todos los datos
  691.                     IF bus = 1 THEN
  692.                         busclave$ = "SELECT apodo, nombre, codigo FROM cliente ORDER BY nombre" + CHR$(0)
  693.                     ELSE
  694.                         busclave$ = "SELECT apodo, nombre, codigo FROM cliente ORDER BY apodo" + CHR$(0)
  695.                     END IF
  696.                     CALL basedato(busclave$, rows, columns)
  697.                     IF rows <> 0 THEN
  698.                         LOCATE 10, 10: PRINT " ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ<" + CHR$(24) + ">ÍÍÍÍÍÍÍÍÍ<" + CHR$(25) + ">ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ "
  699.                         COLOR 0, 7
  700.                         EXIT DO
  701.                     END IF
  702.                 ELSE
  703.                     '--busqueda que contenga frase
  704.                     a$ = MID$(a$, 2)
  705.                     IF bus = 1 THEN
  706.                         busclave$ = "SELECT apodo, nombre, codigo FROM cliente WHERE nombre LIKE '%" + a$ + "%' ORDER BY nombre" + CHR$(0)
  707.                     ELSE
  708.                         busclave$ = "SELECT apodo, nombre, codigo FROM cliente WHERE apodo LIKE '%" + a$ + "%' ORDER BY apodo" + CHR$(0)
  709.                     END IF
  710.                     CALL basedato(busclave$, rows, columns)
  711.                     IF rows <> 0 THEN
  712.                         LOCATE 10, 10: PRINT " ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ<" + CHR$(24) + ">ÍÍÍÍÍÍÍÍÍ<" + CHR$(25) + ">ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ "
  713.                         COLOR 0, 7
  714.                         EXIT DO
  715.                     END IF
  716.                 END IF
  717.             END IF
  718.         END IF
  719.     LOOP
  720.     max = rows: loca = 1
  721.     GOSUB impridatos
  722.     DO
  723.         x$ = "": WHILE x$ = "": x$ = INKEY$: WEND
  724.         x$ = UCASE$(x$)
  725.         x = ASC(RIGHT$(x$, 1))
  726.         SELECT CASE x
  727.             CASE IS = 27
  728.                 a$ = "@"
  729.                 GOTO salbuspais
  730.             CASE IS = 13
  731.                 a$ = DB_RESULT(3, loca)
  732.                 GOTO salbuspais
  733.             CASE IS = 72: '--Subir
  734.                 IF loca > 1 THEN
  735.                     loca = loca - 1
  736.                     GOSUB impridatos
  737.                 END IF
  738.             CASE IS = 80: '--Bajar
  739.                 IF loca < max THEN
  740.                     loca = loca + 1
  741.                     GOSUB impridatos
  742.                 END IF
  743.         END SELECT
  744.     LOOP
  745.     COLOR 15, 0
  746.     GOTO salbuspais
  747.  
  748.     impridatos:
  749.     y = 1
  750.     FOR n = loca - 2 TO loca + 2
  751.         IF n < 1 OR n > max THEN
  752.             COLOR 1, 7
  753.             LOCATE y + 4, 10: PRINT " º                                                               º "
  754.             COLOR 15, 0
  755.             LOCATE y + 4, 12: PRINT "                                                               "
  756.         ELSE
  757.             IF n = loca THEN
  758.                 COLOR 1, 7
  759.             ELSE
  760.                 COLOR 7, 0
  761.             END IF
  762.             LOCATE y + 4, 12: PRINT "                                                               "
  763.             LOCATE y + 4, 13: PRINT LEFT$(DB_RESULT(1, n), 15)
  764.             LOCATE y + 4, 29: PRINT LEFT$(DB_RESULT(2, n), 40)
  765.             LOCATE y + 4, 70: PRINT LEFT$(DB_RESULT(3, n), 4)
  766.         END IF
  767.         y = y + 1
  768.     NEXT
  769.     RETURN
  770.  
  771.     salbuspais:
  772.     '-salir
  773.     PCOPY 2, 0
  774.     COLOR 15, 0
  775.  
  777.  
  778. SUB buscapro (a$)
  779.     '------------------------- BUSCAR POR NOMBRE PROVEEDORES ----------------------------
  780.     PCOPY 0, 2
  781.     REDIM DB_RESULT(columns, rows) AS STRING
  782.     COLOR 7, 1
  783.     LOCATE 25, 1: PRINT SPACE$(80);
  784.     COLOR 1, 7
  785.     bus = 2
  786.     LOCATE 4, 14: PRINT " ÉÍÍÍÍÍÍÍÍÍÍ Busqueda de Proveedores por Apodo     ÍÍÍÍÍÍÍÍÍ» "
  787.     LOCATE 5, 14: PRINT " º                                                          º "
  788.     LOCATE 6, 14: PRINT " º                                                          º "
  789.     LOCATE 7, 14: PRINT " º                                                          º "
  790.     LOCATE 8, 14: PRINT " º                                                          º "
  791.     LOCATE 9, 14: PRINT " º                 *Texto=Busqueda generica                 º "
  792.     LOCATE 10, 14: PRINT " ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ<Esc>ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ "
  793.     DO
  794.         si = 0
  795.         IF bus = 1 THEN
  796.             y = 7: x = 17: a$ = "": l = 40: sp = 40: nu$ = "T"
  797.         ELSE
  798.             y = 7: x = 17: a$ = "": l = 10: sp = 40: nu$ = "T"
  799.         END IF
  800.         CALL rutimput(y, x, a$, l, ant, sp, nu$)
  801.         IF ant = 2 THEN a$ = "@": fin = 1: EXIT DO
  802.         IF ant = 62 THEN
  803.             IF bus = 1 THEN
  804.                 bus = 2
  805.                 LOCATE 4, 14: PRINT " ÉÍÍÍÍÍÍÍÍÍÍ Busqueda de Proveedores por Apodo     ÍÍÍÍÍÍÍÍÍ» "
  806.             ELSE
  807.                 IF bus = 2 THEN
  808.                     bus = 1
  809.                     LOCATE 4, 14: PRINT " ÉÍÍÍÍÍÍÍÍÍÍ Busqueda de Proveedores por Apellido  ÍÍÍÍÍÍÍÍÍ» "
  810.                 END IF
  811.             END IF
  812.         END IF
  813.         IF a$ <> "" THEN
  814.             IF LEFT$(a$, 1) <> "*" THEN
  815.                 '--busqueda por iniciales
  816.                 IF bus = 1 THEN
  817.                     busclave$ = "SELECT apodo, nombre, codigo FROM proveedor WHERE nombre LIKE '" + a$ + "%'" + CHR$(0)
  818.                 ELSE
  819.                     busclave$ = "SELECT apodo, nombre, codigo FROM proveedor WHERE apodo LIKE '" + a$ + "%'" + CHR$(0)
  820.                 END IF
  821.                 CALL basedato(busclave$, rows, columns)
  822.                 IF rows <> 0 THEN
  823.                     LOCATE 10, 14: PRINT " ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ<"; CHR$(24); ">ÍÍÍÍÍÍÍÍÍÍ<"; CHR$(25); ">ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ "
  824.                     COLOR 0, 7
  825.                     EXIT DO
  826.                 END IF
  827.             ELSE
  828.                 IF LEN(a$) = 1 THEN
  829.                     '--busqueda de todos los datos
  830.                     IF bus = 1 THEN
  831.                         busclave$ = "SELECT apodo, nombre, codigo FROM proveedor ORDER BY nombre" + CHR$(0)
  832.                     ELSE
  833.                         busclave$ = "SELECT apodo, nombre, codigo FROM proveedor ORDER BY apodo" + CHR$(0)
  834.                     END IF
  835.                     CALL basedato(busclave$, rows, columns)
  836.                     IF rows <> 0 THEN
  837.                         LOCATE 10, 14: PRINT " ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ<"; CHR$(24); ">ÍÍÍÍÍÍÍÍÍÍ<"; CHR$(25); ">ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ "
  838.                         COLOR 0, 7
  839.                         EXIT DO
  840.                     END IF
  841.                 ELSE
  842.                     '--busqueda que contenga frase
  843.                     a$ = MID$(a$, 2)
  844.                     IF bus = 1 THEN
  845.                         busclave$ = "SELECT apodo, nombre, codigo FROM proveedor WHERE nombre LIKE '%" + a$ + "%' ORDER BY nombre" + CHR$(0)
  846.                     ELSE
  847.                         busclave$ = "SELECT apodo, nombre, codigo FROM proveedor WHERE apodo LIKE '%" + a$ + "%' ORDER BY apodo" + CHR$(0)
  848.                     END IF
  849.                     CALL basedato(busclave$, rows, columns)
  850.                     IF rows <> 0 THEN
  851.                         LOCATE 10, 14: PRINT " ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ<"; CHR$(24); ">ÍÍÍÍÍÍÍÍÍÍ<"; CHR$(25); ">ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ "
  852.                         COLOR 0, 7
  853.                         EXIT DO
  854.                     END IF
  855.                 END IF
  856.             END IF
  857.         END IF
  858.     LOOP
  859.     max = rows: loca = 1
  860.     GOSUB impridatos
  861.     DO
  862.         x$ = "": WHILE x$ = "": x$ = INKEY$: WEND
  863.         x$ = UCASE$(x$)
  864.         x = ASC(RIGHT$(x$, 1))
  865.         SELECT CASE x
  866.             CASE IS = 27
  867.                 a$ = "@"
  868.                 GOTO salbuspais
  869.             CASE IS = 13
  870.                 a$ = DB_RESULT(3, loca)
  871.                 GOTO salbuspais
  872.             CASE IS = 72: '--Subir
  873.                 IF loca > 1 THEN
  874.                     loca = loca - 1
  875.                     GOSUB impridatos
  876.                 END IF
  877.             CASE IS = 80: '--Bajar
  878.                 IF loca < max THEN
  879.                     loca = loca + 1
  880.                     GOSUB impridatos
  881.                 END IF
  882.         END SELECT
  883.     LOOP
  884.     COLOR 15, 0
  885.     GOTO salbuspais
  886.  
  887.     impridatos:
  888.     y = 1
  889.     FOR n = loca - 2 TO loca + 2
  890.         IF n < 1 OR n > max THEN
  891.             COLOR 1, 7
  892.             LOCATE y + 4, 14: PRINT " º                                                          º "
  893.             COLOR 15, 0
  894.             LOCATE y + 4, 17: PRINT "                                                        "
  895.         ELSE
  896.             IF n = loca THEN
  897.                 COLOR 1, 7
  898.             ELSE
  899.                 COLOR 7, 0
  900.             END IF
  901.             LOCATE y + 4, 17: PRINT "                                                        "
  902.             LOCATE y + 4, 17: PRINT LEFT$(DB_RESULT(1, n), 10)
  903.             LOCATE y + 4, 28: PRINT LEFT$(DB_RESULT(2, n), 40)
  904.             LOCATE y + 4, 69: PRINT LEFT$(DB_RESULT(3, n), 4)
  905.         END IF
  906.         y = y + 1
  907.     NEXT
  908.     RETURN
  909.  
  910.     salbuspais:
  911.     '-salir
  912.     PCOPY 2, 0
  913.     COLOR 15, 0
  915.  
  916. SUB consuart (a$)
  917.     '------------------------- BUSCAR POR NOMBRE ARTICULO ----------------------------
  918.     PCOPY 0, 2
  919.     REDIM DB_RESULT(columns, rows) AS STRING
  920.     COLOR 7, 1
  921.     LOCATE 25, 1: PRINT SPACE$(80);
  922.     COLOR 1, 7
  923.     LOCATE 4, 14: PRINT " ÉÍÍ Busqueda de Articulos ÍÍ» "
  924.     LOCATE 5, 14: PRINT " º                           º "
  925.     LOCATE 6, 14: PRINT " º                           º "
  926.     LOCATE 7, 14: PRINT " º                           º "
  927.     LOCATE 8, 14: PRINT " º                           º "
  928.     LOCATE 9, 14: PRINT " º *Texto=Busqueda generica  º "
  929.     LOCATE 10, 14: PRINT " ÈÍÍÍÍÍÍÍÍÍÍÍ<Esc>ÍÍÍÍÍÍÍÍÍÍͼ "
  930.     DO
  931.         si = 0
  932.         y = 7: x = 17: a$ = "": l = 20: sp = 20: nu$ = "T"
  933.         CALL rutimput(y, x, a$, l, ant, sp, nu$)
  934.         IF ant = 2 THEN a$ = "@": fin = 1: EXIT DO
  935.         IF a$ <> "" THEN
  936.             IF LEFT$(a$, 1) <> "*" THEN
  937.                 '--busqueda por iniciales
  938.                 busclave$ = "SELECT nombre, codigo FROM articulo WHERE nombre LIKE '" + a$ + "%'" + CHR$(0)
  939.                 CALL basedato(busclave$, rows, columns)
  940.                 IF rows = 0 THEN
  941.                     '--BEEP
  942.                 ELSE
  943.                     LOCATE 10, 20: PRINT "<"; CHR$(24); ">ÍÍ<"; CHR$(25); ">"
  944.                     COLOR 0, 7
  945.                     EXIT DO
  946.                 END IF
  947.             ELSE
  948.                 IF LEN(a$) = 1 THEN
  949.                     '--busqueda de todos los datos
  950.                     busclave$ = "SELECT nombre, codigo FROM articulo" + CHR$(0)
  951.                     CALL basedato(busclave$, rows, columns)
  952.                     IF rows = 0 THEN
  953.                         '--BEEP
  954.                     ELSE
  955.                         LOCATE 10, 20: PRINT "<"; CHR$(24); ">ÍÍ<"; CHR$(25); ">"
  956.                         COLOR 0, 7
  957.                         EXIT DO
  958.                     END IF
  959.                 ELSE
  960.                     '--busqueda que contenga frase
  961.                     IF LEN(a$) > 1 THEN
  962.                         a$ = MID$(a$, 2)
  963.                         busclave$ = "SELECT nombre, codigo FROM articulo WHERE nombre LIKE '%" + a$ + "%'" + CHR$(0)
  964.                         CALL basedato(busclave$, rows, columns)
  965.                         IF rows <> 0 THEN
  966.                             LOCATE 10, 20: PRINT "<"; CHR$(24); ">ÍÍ<"; CHR$(25); ">"
  967.                             COLOR 0, 7
  968.                             EXIT DO
  969.                         END IF
  970.                     END IF
  971.                 END IF
  972.             END IF
  973.         END IF
  974.     LOOP
  975.     max = rows: loca = 1
  976.     GOSUB impridatos
  977.     DO
  978.         x$ = "": WHILE x$ = "": x$ = INKEY$: WEND
  979.         x$ = UCASE$(x$)
  980.         x = ASC(RIGHT$(x$, 1))
  981.         SELECT CASE x
  982.             CASE IS = 27
  983.                 a$ = "@"
  984.                 GOTO salbuspais
  985.             CASE IS = 13
  986.                 a$ = DB_RESULT(2, loca)
  987.                 GOTO salbuspais
  988.             CASE IS = 72: '--Subir
  989.                 IF loca > 1 THEN
  990.                     loca = loca - 1
  991.                     GOSUB impridatos
  992.                 END IF
  993.             CASE IS = 80: '--Bajar
  994.                 IF loca < max THEN
  995.                     loca = loca + 1
  996.                     GOSUB impridatos
  997.                 END IF
  998.         END SELECT
  999.     LOOP
  1000.     COLOR 15, 0
  1001.     GOTO salbuspais
  1002.  
  1003.     impridatos:
  1004.     y = 1
  1005.     FOR n = loca - 2 TO loca + 2
  1006.         IF n < 1 OR n > max THEN
  1007.             COLOR 1, 7
  1008.             LOCATE y + 4, 14: PRINT " º                           º "
  1009.             COLOR 15, 0
  1010.             LOCATE y + 4, 17: PRINT "                          "
  1011.         ELSE
  1012.             IF n = loca THEN
  1013.                 COLOR 1, 7
  1014.             ELSE
  1015.                 COLOR 7, 0
  1016.             END IF
  1017.             LOCATE y + 4, 17: PRINT "                          "
  1018.             LOCATE y + 4, 17: PRINT DB_RESULT(1, n)
  1019.             LOCATE y + 4, 40: PRINT DB_RESULT(2, n)
  1020.         END IF
  1021.         y = y + 1
  1022.     NEXT
  1023.     RETURN
  1024.  
  1025.     salbuspais:
  1026.     '-salir
  1027.     PCOPY 2, 0
  1028.     COLOR 15, 0
  1030.  
  1031. SUB predeter (impresora$)
  1032.     mimpresora$ = ""
  1033.     PCOPY 0, 3
  1034.     COLOR 15, 0
  1035.     SHELL _HIDE "cmd/c wmic printer get name, default> impresora.txt"
  1036.     DIM impresora(50) AS STRING
  1037.     OPEN "I", 10, "impresora.txt"
  1038.     n% = 0
  1039.     LINE INPUT #10, dato$
  1040.     DO
  1041.         LINE INPUT #10, dato$: LINE INPUT #10, dato$
  1042.         IF EOF(10) THEN EXIT DO
  1043.         n% = n% + 1
  1044.         DO
  1045.             a% = INSTR(dato$, CHR$(0))
  1046.             IF a% = 0 THEN EXIT DO
  1047.             IF a% = 1 THEN
  1048.                 dato$ = MID$(dato$, a% + 1)
  1049.             ELSEIF a% = LEN(dato$) THEN
  1050.                 dato$ = LEFT$(dato$, a% - 1)
  1051.             ELSE
  1052.                 dato$ = LEFT$(dato$, a% - 1) + MID$(dato$, a% + 1)
  1053.             END IF
  1054.         LOOP
  1055.         a% = INSTR(dato$, "FALSE"): b% = INSTR(dato$, "TRUE")
  1056.         IF a% <> 0 THEN
  1057.             MID$(dato$, a%, 5) = SPACE$(5)
  1058.             dato$ = LTRIM$(RTRIM$(dato$))
  1059.         END IF
  1060.         IF b% <> 0 THEN
  1061.             MID$(dato$, b%, 5) = SPACE$(4)
  1062.             dato$ = LTRIM$(RTRIM$(dato$))
  1063.             loca% = n%
  1064.             IF impresora$ = "" THEN mimpresora$ = dato$
  1065.         END IF
  1066.         impresora(n%) = dato$
  1067.         impresora(0) = LTRIM$(STR$(n%))
  1068.     LOOP
  1069.     CLOSE 10
  1070.     COLOR 1, 7
  1071.     LOCATE 8, 20: PRINT "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
  1072.     LOCATE 9, 20: PRINT "º                                        º"
  1073.     LOCATE 10, 20: PRINT "ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹"
  1074.     LOCATE 11, 20: PRINT "º                                        º"
  1075.     LOCATE 12, 20: PRINT "º                                        º"
  1076.     LOCATE 13, 20: PRINT "º                                        º"
  1077.     LOCATE 14, 20: PRINT "º                                        º"
  1078.     LOCATE 15, 20: PRINT "º                                        º"
  1079.     LOCATE 16, 20: PRINT "ÈÍÍÍÍÍÍÍ<Esc>ÍÍÍÍ<"; CHR$(24); ">Í<"; CHR$(25); ">ÍÍÍÍ<"; CHR$(17); CHR$(217); ">ÍÍÍÍÍÍÍÍͼ"
  1080.     COLOR 15, 1
  1081.     LOCATE 9, 21: PRINT "          SELECCIONAR IMPRESORA         ";
  1082.     COLOR 1, 7
  1083.     max% = VAL(impresora(0))
  1084.     GOSUB impridatos
  1085.     DO
  1086.         x$ = "": WHILE x$ = "": x$ = INKEY$: WEND
  1087.         x$ = UCASE$(x$)
  1088.         x% = ASC(RIGHT$(x$, 1))
  1089.         SELECT CASE x%
  1090.             CASE IS = 27
  1091.                 a$ = "@"
  1092.                 EXIT DO
  1093.             CASE IS = 13
  1094.                 a$ = impresora(loca%)
  1095.                 EXIT DO
  1096.             CASE IS = 72: '--Subir
  1097.                 IF loca% > 1 THEN
  1098.                     loca% = loca% - 1
  1099.                     GOSUB impridatos
  1100.                 END IF
  1101.             CASE IS = 80: '--Bajar
  1102.                 IF loca% < max% THEN
  1103.                     loca% = loca% + 1
  1104.                     GOSUB impridatos
  1105.                 END IF
  1106.         END SELECT
  1107.     LOOP
  1108.     IF a$ <> "@" THEN
  1109.         SHELL _HIDE "cmd/c wmic printer where name='" + a$ + "' call setdefaultprinter"
  1110.         LOCATE 20, 20: PRINT "Impresora seleccionada: "; a$: SLEEP 3
  1111.         IF a$ <> mimpresora$ THEN
  1112.             IF impresora$ = "" THEN impresora$ = mimpresora$
  1113.         END IF
  1114.     ELSE
  1115.         LOCATE 20, 20: PRINT "No se ha modificado la impresora": SLEEP 3
  1116.     END IF
  1117.     KILL "impresora.txt"
  1118.     COLOR 15, 0
  1119.     PCOPY 3, 0
  1120.     EXIT SUB
  1121.  
  1122.     impridatos:
  1123.     y% = 1
  1124.     FOR n% = loca% - 2 TO loca% + 2
  1125.         IF n% < 1 OR n% > max% THEN
  1126.             COLOR 1, 7: LOCATE y% + 10, 21: PRINT "                                        "
  1127.         ELSE
  1128.             IF n% = loca% THEN COLOR 15, 4 ELSE COLOR 1, 7
  1129.             LOCATE y% + 10, 21: PRINT "                                        "
  1130.             LOCATE y% + 10, 21: PRINT LEFT$(impresora(n%), 40)
  1131.         END IF
  1132.         y% = y% + 1
  1133.     NEXT
  1134.     RETURN
  1136.  
  1137. SUB buspais (a$)
  1138.     '------------------------- BUSCAR POR PAIS ----------------------------
  1139.     PCOPY 0, 2
  1140.     max = 29
  1141.     DIM venta$(max)
  1142.     venta$(1) = "ESPA¥A         ES"
  1143.     venta$(2) = "ESPA¥A(CANAR.) E-"
  1144.     venta$(3) = "ALEMANIA       DE"
  1145.     venta$(4) = "AUSTRIA        AT"
  1146.     venta$(5) = "BELGICA        BE"
  1147.     venta$(6) = "BULGARIA       BG"
  1148.     venta$(7) = "CHIPRE         CY"
  1149.     venta$(8) = "CHEQUIA        CZ"
  1150.     venta$(9) = "DINAMARCA      DK"
  1151.     venta$(10) = "ESLOVENIA      SI"
  1152.     venta$(11) = "ESLOVAQUIA     SK"
  1153.     venta$(12) = "ESTONIA        EE"
  1154.     venta$(13) = "FINLANDIA      FI"
  1155.     venta$(14) = "FRANCIA        FR"
  1156.     venta$(15) = "GRECIA         EL"
  1157.     venta$(16) = "GRAN BRETA¥A   GB"
  1158.     venta$(17) = "HOLANDA        NL"
  1159.     venta$(18) = "HUNGRIA        HU"
  1160.     venta$(19) = "ITALIA         IT"
  1161.     venta$(20) = "IRLANDA        IE"
  1162.     venta$(21) = "LITUANIA       LT"
  1163.     venta$(22) = "LUXEMBURGO     LU"
  1164.     venta$(23) = "LETONIA        LV"
  1165.     venta$(24) = "MALTA          MT"
  1166.     venta$(25) = "MARRUECOS      MA"
  1167.     venta$(26) = "POLONIA        PL"
  1168.     venta$(27) = "PORTUGAL       PT"
  1169.     venta$(28) = "RUMANIA        RO"
  1170.     venta$(29) = "SUECIA         SE"
  1171.  
  1172.     COLOR 7, 1
  1173.     LOCATE 25, 1: PRINT SPACE$(80);
  1174.     COLOR 1, 7
  1175.     LOCATE 4, 25: PRINT " ÉÍÍ    Codigo de Paises   ÍÍ» "
  1176.     LOCATE 5, 25: PRINT " º                           º "
  1177.     LOCATE 6, 25: PRINT " º                           º "
  1178.     LOCATE 7, 25: PRINT " º                           º "
  1179.     LOCATE 8, 25: PRINT " º                           º "
  1180.     LOCATE 9, 25: PRINT " º                           º "
  1181.     LOCATE 10, 25: PRINT " ÈÍÍÍÍÍÍÍÍÍÍÍ<Esc>ÍÍÍÍÍÍÍÍÍÍͼ "
  1182.     LOCATE 10, 36: PRINT "<"; CHR$(24); ">ÍÍ<"; CHR$(25); ">"
  1183.     loca = 0
  1184.     FOR n = 1 TO max
  1185.         IF MID$(venta$(n), 16, 2) = a$ THEN loca = n: EXIT FOR
  1186.     NEXT
  1187.     IF loca = 0 THEN loca = 1
  1188.     GOSUB impridatos
  1189.     DO
  1190.         x$ = "": WHILE x$ = "": x$ = INKEY$: WEND
  1191.         x$ = UCASE$(x$)
  1192.         x = ASC(RIGHT$(x$, 1))
  1193.         SELECT CASE x
  1194.             CASE IS = 27
  1195.                 a$ = "@"
  1196.                 GOTO salbuspais
  1197.             CASE IS = 13
  1198.                 a$ = MID$(venta$(loca), 16, 2)
  1199.                 GOTO salbuspais
  1200.             CASE IS = 72: '--Subir
  1201.                 IF loca > 1 THEN
  1202.                     loca = loca - 1
  1203.                     GOSUB impridatos
  1204.                 END IF
  1205.             CASE IS = 80: '--Bajar
  1206.                 IF loca < max THEN
  1207.                     loca = loca + 1
  1208.                     GOSUB impridatos
  1209.                 END IF
  1210.         END SELECT
  1211.     LOOP
  1212.     COLOR 15, 0
  1213.     GOTO salbuspais
  1214.  
  1215.     impridatos:
  1216.     y = 1
  1217.     FOR n = loca - 2 TO loca + 2
  1218.         IF n < 1 OR n > max THEN
  1219.             COLOR 1, 7
  1220.             LOCATE y + 4, 25: PRINT " º                           º "
  1221.             COLOR 15, 0
  1222.             LOCATE y + 4, 27: PRINT "                           "
  1223.         ELSE
  1224.             IF n = loca THEN
  1225.                 COLOR 1, 7
  1226.             ELSE
  1227.                 COLOR 7, 0
  1228.             END IF
  1229.             LOCATE y + 4, 27: PRINT "  "; MID$(venta$(n), 1, 15); "     "
  1230.             LOCATE y + 4, 49: PRINT MID$(venta$(n), 16, 2); "   "
  1231.         END IF
  1232.         y = y + 1
  1233.     NEXT
  1234.     RETURN
  1235.  
  1236.  
  1237.     salbuspais:
  1238.     '-salir
  1239.     PCOPY 2, 0
  1240.     COLOR 15, 0
  1242.  

Also attached are the 32-bit mysql libraries
Logged

Offline Juanjogomez

  • Forum Regular
  • Posts: 117
    • View Profile
Re: Problem whith install in windows 10 Home
« Reply #12 on: June 08, 2020, 11:29:07 am »
I also attach the database
Logged

Offline luke

  • Administrator
  • Seasoned Forum Regular
  • Posts: 324
    • View Profile
Re: Problem whith install in windows 10 Home
« Reply #13 on: June 08, 2020, 12:32:44 pm »
In several places you call mysql_* functions without null-terminating your strings. This is potentially a problem.
Logged

Offline Juanjogomez

  • Forum Regular
  • Posts: 117
    • View Profile
Re: Problem whith install in windows 10 Home
« Reply #14 on: June 08, 2020, 12:43:36 pm »
Tanks for your time.
In what specific lines? And why does it work on some computers and not on others?
Logged
Pages: [1] 2   Go Up
« previous next »