-
Notifications
You must be signed in to change notification settings - Fork 0
/
consorcio02.PRG
475 lines (350 loc) · 11 KB
/
consorcio02.PRG
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
*******************************************************************
*
* NOMBRE : Consorcio01.prg
* GRUPO : 11 - Hab.Profesional - FRC - UTN
* VERSIÓN : 0.2
*
*******************************************************************
* Este programa tiene como objetivo iniciar y finalizar la
* Aplicación Consorcios delegando responsabilidades en los
* correspondientes subprogramas
*
*******************************************************************
*CLOSE ALL
CLEAR ALL
********* SETEOS *************************************************
*SET STEP ON
SET TALK OFF
SET NOTIFY OFF
SET DELETE ON
SET DATE DMY
SET CENTURY ON
******** DEFINICIONES ********************************************
*************** MAIN ******************************************
CLEAR ALL
CLOSE DATABASES
OPEN DATABASE Aromal
USE Gastos_Detalle IN 0
PUBLIC gnSecurityLevel
gnSecurityLevel = 0
frmPaso = CREATEOBJECT("Pass")
frmPaso.Show()
*READ EVENTS
IF gnSecurityLevel != 0
frmPrincipalConsorcio = CREATEOBJECT("cfrmPrincipalConsorcio")
frmPrincipalConsorcio.Show(1)
SET STATUS BAR OFF
READ EVENTS
ENDIF
CLOSE TABLES ALL
CLEAR ALL
CLOSE DATABASES
*
********* DEFINICIONES DE CLASES ********************************
DEFINE CLASS Pass AS FORM
ShowWindow = 1
WindowType = 1
AutoCenter = .T.
AlwaysOnTop = .T.
ControlBox = .F.
SizeBox = .F.
BorderStyle = 2
ScaleMode = 3
MaxButton = .F.
MinButton = .F.
* HalfHeightCaption = .T.
Movable = .F.
Caption = "Introduzca nombre de usuario y password"
* Closable = .F.
Width = 260
Height = 115
ADD OBJECT olblusuario AS LABEL ;
WITH Caption = "Usuario:", ;
Left = 15, ;
Top = 25
ADD OBJECT olblpassword AS LABEL ;
WITH Caption = "Password:", ;
Left = 15, ;
Top = 60
ADD OBJECT olblresultado AS LABEL ;
WITH Caption = "", ;
AutoSize = .T., ;
FontItalic = .T., ;
FontBold = .T., ;
ForeColor = RGB(0,55,255), ;
Left = 45, ;
Top = 92
ADD OBJECT otbxusuario AS TEXTBOX ;
WITH Left = 95, ;
Top = 23, ;
Width = 130
ADD OBJECT otbxpassword AS TEXTBOX ;
WITH Left = 95, ;
Top = 57, ;
Width = 130, ;
PasswordChar = '*'
PROCEDURE otbxpassword.GotFocus
* SET CURSOR OFF
SET CURSOR ON
ENDPROC
PROCEDURE otbxpassword.LostFocus
SET CURSOR ON
ENDPROC
PROCEDURE otbxusuario.Valid
IF LASTKEY() = 5 .OR. LASTKEY() = 24 .OR. LASTKEY() = 4 .OR. LASTKEY() = 19
RETURN .F.
ELSE
RETURN .T.
ENDIF
ENDPROC
PROCEDURE otbxpassword.KeyPress
PARAMETERS nKeyCode, nShiftAltCtrl
NODEFAULT
DO CASE
CASE BETWEEN(nKeyCode, 33, 126)
This.Value = ALLTRIM(This.Value) + CHR(nKeyCode)
CASE nKeyCode = 13 .AND. LEN(This.Value) < 128
* Password,
* puede contener mayúsculas, minúsculas, dígitos y signos especiales,
* más específicamente las posiciones que van de la 33 a la 126 del
* ASCII Character Set
* Password encriptado
LOCAL cpassenc
cpassenc = SPACE(128)
IF LEN(ALLTRIM(This.Value)) > 0
encriptar(This.Value, @cpassenc, 0)
ENDIF
SELECT Usuarios
SET ORDER TO 1
SEEK LOWER(ALLTRIM(Thisform.otbxusuario.Value))
IF FOUND()
IF Usuarios.passenc == LEFT(cpassenc,13)
Thisform.olblresultado.Caption = "Usuario validado"
WAIT "" TIMEOUT 1
gnSecurityLevel = nivel
Thisform.release()
ELSE
Thisform.olblresultado.Caption = "Fallo en la validación"
WAIT "" TIMEOUT 1
gnSecurityLevel = 0
Thisform.release()
ENDIF
ELSE
Thisform.olblresultado.Caption = "Fallo en la validación"
WAIT "" TIMEOUT 1
gnSecurityLevel = 0
Thisform.release()
ENDIF
CASE nKeyCode = 127
This.Value = LEFT(This.Value,(LEN(This.Value)-1))
CASE nKeyCode = 9
Thisform.otbxusuario.setFocus
ENDCASE
ENDPROC
PROCEDURE Init
DECLARE INTEGER blowfish_encrypt_pass IN blowfish.dll AS encriptar ;
STRING , STRING @, INTEGER i
ENDPROC
PROCEDURE Load
IF !USED("Usuarios")
USE Usuarios
ENDIF
ENDPROC
PROCEDURE Destroy
CLEAR DLLS
CLEAR EVENTS
ENDPROC
ENDDEFINE
DEFINE CLASS cfrmPrincipalConsorcio AS Form
BackColor = RGB(192, 192, 192)
Caption = "Administrador de Consorcios 1.00"
Desktop = .T.
Height = 540
Width = 790
Icon = "Aromal.ico"
Top = 0
Left = 0
ScaleMode = 3
ShowWindow = 2
KeyPreview = .T.
FontName = "Times New Roman"
FontSize = 16
* Picture = "Logo2.bmp"
ADD OBJECT Logo AS Image ;
WITH Picture = "Logo3.bmp", ;
Left = 250, ;
Top = 100
PROCEDURE Init
Application.Visible = .F.
DO MenuCons02 WITH THIS
ENDPROC
PROCEDURE Destroy
CLEAR EVENTS
RELEASE MENU mPrincipalConsorcio EXTENDED
ENDPROC
ENDDEFINE
********* PROCEDIMIENTOS ****************************************
PROCEDURE MenuCons02
LPARAMETERS oFormRef
DEFINE MENU mPrincipalConsorcio ;
IN (oFormRef.Name) ;
BAR ;
FONT 'Courier', 38 ;
STYLE 'N' ;
MESSAGE " ¿ Cuándo sale este mensaje ?? Hee? "
DEFINE PAD padConsorcio OF mPrincipalConsorcio ;
PROMPT '\<Consorcios' ;
KEY ALT+C, '' ;
MESSAGE "Gestión de los Consorcios " ;
COLOR SCHEME 3
ON PAD padConsorcio OF mPrincipalConsorcio ;
ACTIVATE POPUP popConsorcio
DEFINE POPUP popConsorcio MARGIN RELATIVE COLOR SCHEME 4
DEFINE BAR 1 OF popConsorcio PROMPT '\<Nuevo' ;
KEY CTRL+N, '^N' ;
MESSAGE " Permite registra un nuevo Consorcio "
ON SELECTION BAR 1 OF popConsorcio ;
DO NuevoCons
DEFINE BAR 2 OF popConsorcio PROMPT '\<Modificar' ;
KEY CTRL+M, '^M' ;
MESSAGE " Permite modificar los atributos del Consorcio actual"
ON SELECTION BAR 2 OF popConsorcio ;
DO ModCons
DEFINE BAR 3 OF popConsorcio PROMPT 'E\<liminar' ;
KEY CTRL+L, '^L' ;
MESSAGE "Elimina el Consorcio actual de la Base de Datos "
ON SELECTION BAR 3 OF popConsorcio ;
DO BajaCons
DEFINE BAR 4 OF popConsorcio PROMPT '\-' ;
DEFINE BAR 5 OF popConsorcio PROMPT '\<Salir ' ;
KEY ALT+F4, 'Alt+F4' ;
MESSAGE "Sale de la aplicación "
ON SELECTION BAR 5 OF popConsorcio CLEAR EVENTS
DEFINE PAD padUnidades OF mPrincipalConsorcio ;
PROMPT '\<Unidades' ;
KEY ALT+U, '' ;
MESSAGE "Gestión de las Unidades " ;
COLOR SCHEME 3
ON PAD padUnidades OF mPrincipalConsorcio ;
ACTIVATE POPUP popUnidades
DEFINE POPUP popUnidades MARGIN RELATIVE COLOR SCHEME 4
DEFINE BAR 1 OF popUnidades PROMPT '\<Cargar ' ;
KEY ALT+C, '' ;
MESSAGE " Permite cargar las unidades del Consorcio actual "
ON SELECTION BAR 1 OF popUnidades ;
DO cargaruni
DEFINE BAR 2 OF popUnidades PROMPT '\<Modificar ' ;
KEY ALT+M, '' ;
MESSAGE " Permite modificar las unidades del Consorcio actual "
ON SELECTION BAR 2 OF popUnidades ;
DO ModUni
DEFINE BAR 3 OF popUnidades PROMPT '\<Eliminar ' ;
KEY ALT+E, '' ;
MESSAGE " Permite eliminar unidades del Consorcio actual "
ON SELECTION BAR 3 OF popUnidades ;
DO BajaUni
DEFINE PAD padExpensas OF mPrincipalConsorcio ;
PROMPT '\<Expensas' ;
KEY ALT+E, '' ;
MESSAGE "Gestión de las Expensas " ;
COLOR SCHEME 3
ON PAD padExpensas OF mPrincipalConsorcio ;
ACTIVATE POPUP popExpensas
DEFINE POPUP popExpensas MARGIN RELATIVE COLOR SCHEME 4
DEFINE BAR 1 OF popExpensas PROMPT '\<Registrar prorrateos ' ;
KEY ALT+R, '' ;
MESSAGE " Permite cargar las incidencias de las unidades "
ON SELECTION BAR 1 OF popExpensas ;
DO FORM "car_expensa2"
DEFINE PAD padGastos OF mPrincipalConsorcio ;
PROMPT '\<Gastos' ;
KEY ALT+E, '' ;
MESSAGE "Gestión de las Expensas " ;
COLOR SCHEME 3
ON SELECTION PAD padGastos OF mPrincipalConsorcio ;
DO FORM SAN_GASTOS
DEFINE PAD padLiquidación OF mPrincipalConsorcio ;
PROMPT '\<Liquidar' ;
KEY ALT+L, '' ;
MESSAGE "Liquidación de las expensas" ;
COLOR SCHEME 3
ON SELECTION PAD padLiquidación OF mPrincipalConsorcio ;
Do Form "liquidarse_3"
DEFINE PAD padPagos OF mPrincipalConsorcio ;
PROMPT '\<Pagos' ;
KEY ALT+P, '' ;
MESSAGE "Gestión de Pagos " ;
COLOR SCHEME 3
ON PAD padPagos OF mPrincipalConsorcio ;
ACTIVATE POPUP popPagos
DEFINE POPUP popPagos MARGIN RELATIVE COLOR SCHEME 4
DEFINE BAR 1 OF popPagos PROMPT '\<Pago Rápido ' ;
KEY ALT+R, '' ;
MESSAGE " Pago rápido "
ON SELECTION BAR 1 OF popPagos ;
DO PagoFast
DEFINE BAR 2 OF popPagos PROMPT '\<Pago Completo ' ;
KEY ALT+M, '' ;
MESSAGE " Pago Completo "
ON SELECTION BAR 2 OF popPagos ;
DO Pago
DEFINE PAD padConsultas OF mPrincipalConsorcio ;
PROMPT '\<Consultas' ;
KEY ALT+C, '' ;
MESSAGE "Consultas " ;
COLOR SCHEME 3
ON SELECTION PAD padConsultas OF mPrincipalConsorcio ;
ON PAD padConsultas OF mPrincipalConsorcio ;
ACTIVATE POPUP popConsultas
DEFINE POPUP popConsultas MARGIN RELATIVE COLOR SCHEME 4
DEFINE BAR 1 OF popConsultas PROMPT '\<Morosos mensuales' ;
KEY CTRL+N, '^N' ;
MESSAGE " Busca los morosos mensuales "
ON SELECTION BAR 1 OF popConsultas ;
DO MOROSOS
DEFINE BAR 2 OF popConsorcio PROMPT '\<Modificar' ;
KEY CTRL+M, '^M' ;
MESSAGE " Permite modificar los atributos del Consorcio actual"
DEFINE PAD padListados OF mPrincipalConsorcio ;
PROMPT '\<Listados' ;
KEY ALT+L, '' ;
MESSAGE "Listados pertinentes " ;
COLOR SCHEME 3
DEFINE PAD padAyuda OF mPrincipalConsorcio ;
PROMPT '\<Ayuda' ;
KEY ALT+A, '' ;
MESSAGE "Ayuda del sistema " ;
COLOR SCHEME 3
ON PAD padAyuda OF mPrincipalConsorcio ;
ACTIVATE POPUP popAyuda
DEFINE POPUP popAyuda MARGIN RELATIVE COLOR SCHEME 4
DEFINE BAR 1 OF popAyuda PROMPT '\<Temas de Ayuda' ;
KEY F1, ' F1' ;
MESSAGE " Busca temas de ayuda a partir de las palabras ;
claves especificadas "
ON SELECTION BAR 1 OF popAyuda ;
MESSAGEBOX("Aca comienza la ayuda del Sistema ", (2+48+256), ;
"Ayuda del Sistema Administración de Consorcios 1.00")
DEFINE BAR 2 OF popAyuda PROMPT '\<Acerca de Administración de Consorcios 1.00 ...' ;
MESSAGE " Créditos, Copyright, Miscelánea "
ON SELECTION BAR 2 OF popAyuda ;
MESSAGEBOX("Acerca de Adm. de Consorcios 1.00 ", ;
(2+48+256), "Copyright GRUPO 11 (C) 1999")
ACTIVATE MENU mPrincipalConsorcio NOWAIT
** Falta agregar ABM de usuarios para los niveles
** Superusuario y Total
IF gnSecurityLevel > 2
SET SKIP OF BAR 2 OF popConsorcio .T.
SET SKIP OF BAR 3 OF popConsorcio .T.
SET SKIP OF BAR 2 OF popUnidades .T.
SET SKIP OF BAR 3 OF popUnidades .T.
SET SKIP OF PAD padExpensas OF mPrincipalConsorcio .T.
SET SKIP OF PAD padLiquidación OF mPrincipalConsorcio .T.
SET SKIP OF PAD padPagos OF mPrincipalConsorcio .T.
IF gnSecurityLevel = 4
SET SKIP OF PAD padConsorcio OF mPrincipalConsorcio .T.
SET SKIP OF PAD padUnidades OF mPrincipalConsorcio .T.
SET SKIP OF PAD padGastos OF mPrincipalConsorcio .T.
ENDIF
ENDIF
ENDPROC