Temas

Acabo de leer la noticia, aquí:
Intel no retrasará Haswell por el bug del USB 3.0, pero sí limitará su disponibilidad.

Para los que no conozcan ese fallo:

Las primeras plataformas Intel Haswell tendrán problemas con USB 3.0 y el modo S3.

Me parece increíble, que saquen un producto con ese fallo. Es decir, van a sacar unos pocos procesadores malos que los van a comprar los que no entiendan. Y luego sacarán los procesadores buenos y los que lo vayan a comprar se tragarán los defectuosos que quedaran en stock...

Lo peor va a ser el tema de los portátiles, porque el fallo del USB 3.0 sucede cuando el equipo entra en modo ahorro de energía. Y por no dar mala imagen, Intel va a sacar los procesadores en la fecha prevista... lamentable.

Hola, estoy desarrollando un Kernel y tengo un problema con los strings. El Kernel bootea desde la disquetera, carga el Stage2 y entra en modo largo, luego se inicia el Kernel en C++.

Hasta ahora, lo estaba desarrollando en Windows, usando Nasm y MinGW, pero me encontré con el problema de las cadenas y lo porté a GNU/Linux.

En Windows, mi linker script es este:

Código (bash) [Seleccionar] Expandir


OUTPUT_FORMAT("pe-x86-64")
ENTRY("loader")
SECTIONS
{
    . = 0x100000;
    .text :
    {
        code = .;
        *(.text)
        text_end = .;
    }
    .rodata :
    {
        rodata = text_end;
        *(.rodata)
*(.rdata)
        rodata_end  = .;     
    }   
    .data :
    {
        data = rodata_end;
        *(.data)
        data_end = .;
    }
    .bss : 
    {
        bss = data_end;
        *(.bss)
        bss__end = .;
    }
    end = .;
}


Y compilo todo, con el siguiente bat:

Código [Seleccionar] Expandir


@echo off
set nasm="tools\nasm.exe"
set bochs="C:\Program Files (x86)\Bochs-2.5.1\bochs.exe"
set fat12maker="tools\fat12maker.exe"
set ld="..\MinGW64\bin\x86_64-w64-mingw32-ld.exe"
set cpp="..\MinGW64\bin\x86_64-w64-mingw32-g++.exe"
set objcopy="..\MinGW64\bin\x86_64-w64-mingw32-objcopy.exe"
set cpp_params=-I.\Kernel\ -nostdlib -nostartfiles -nodefaultlibs -masm=intel -fstrength-reduce -fomit-frame-pointer -finline-functions -nostdinc -fno-builtin

mkdir bin\

%nasm% -fbin bootloader\Stage_1.asm -o Stage_1.bin
if NOT %ERRORLEVEL%==0 goto error

%nasm% -fbin bootloader\Stage_2.asm -o Stage_2.bin
if NOT %ERRORLEVEL%==0 goto error

%cpp% %cpp_params% -c Kernel\kernel.cpp -o bin\kernel.o
%cpp% %cpp_params% -c Kernel\Drivers\screen.cpp -o bin\screen.o
%cpp% %cpp_params% -c Kernel\string.cpp -o bin\string.o
%cpp% %cpp_params% -c Kernel\io.cpp -o bin\io.o
%cpp% %cpp_params% -c Kernel\idt.cpp -o bin\idt.o
%nasm% -f win64 Kernel\Stage_3.asm -o bin\Stage_3.o
if NOT %ERRORLEVEL%==0 goto error

%ld% -nostdlib -nodefaultlibs -T linker.ld bin\Stage_3.o bin\kernel.o bin\idt.o bin\screen.o bin\string.o bin\io.o -o Kernel.out
%objcopy% -x -g -X -S -O binary Kernel.out kernel.bin

copy /b Stage_2.bin+kernel.bin Stage_2.bin
if NOT %ERRORLEVEL%==0 goto error

%fat12maker% -b Stage_1.bin -i Stage_2.bin -o Kernel.img
%bochs% -f bochsconf

goto fin

:error
echo Se produjo un error de compilacion
exit

:fin
echo Compilacion satisfactoria
rmdir /S /Q bin\


Se ejecuta bien, pero no se muestran las cadenas que son constantes globales. No puedo hacer algo como esto:

Código (cpp) [Seleccionar] Expandir


const char * interrupts_exceptions[] = {
"0 - Division by zero exception",
"1 - Debug exception",
"2 - Non maskable interrupt",
"3 - Breakpoint exception",
"4 - 'Into detected overflow",
"5 - Out of bounds exception",
"6 - Invalid opcode exception",
"7 - No coprocessor exception",
"8 - Double fault",
"9 - Coprocessor segment overrun",
"10 - Bad TSS",
"11 - Segment not present",
"12 - Stack fault",
"13 - General protection fault",
"14 - Page fault",
"15 - Unknown interrupt exception",
"16 - Coprocessor fault",
"17 - Alignment check exception",
"18 - Machine check exception",
"19 - Reserved exception",
"20 - Reserved exception",
"21 - Reserved exception",
"22 - Reserved exception",
"23 - Reserved exception",
"24 - Reserved exception",
"25 - Reserved exception",
"26 - Reserved exception",
"27 - Reserved exception",
"28 - Reserved exception",
"29 - Reserved exception",
"30 - Reserved exception"
"31 - Reserved exception"};

void idt::init_idt()
{
idt_ptr = (idt_ptr_t*)IDT_ADDRESS;
*idt_entries = (idt_entry_t*)IDT_ADDRESS;

clean_gates();
screen::kprintf("Exceptions pointer: 0x%p\n", ::interrupts_exceptions);
screen::kprintf("String: %s\n", ::interrupts_exceptions[0]); //<--------------------------

idt_set_gate(0, (QWORD)isr0, 0x08, 0x8E);
}


Esto es lo que muestra: http://forum.osdev.org/download/file.php?id=2342&mode=view

Estuve buscando información en http://wiki.osdev.org/Main_Page pero no consigo arreglar el problema.

El linker script de linux es este:

Código (bash) [Seleccionar] Expandir


OUTPUT_FORMAT(binary)
ENTRY(loader)
SECTIONS
{
    . = 0x100000;
    .text :
    {
        code = .;
        *(.text)
        text_end = .;
    }
    .rodata :
    {
        rodata = text_end;
        *(.rodata)
        rodata_end  = .;     
    }   
    .data :
    {
        data = rodata_end;
        *(.data)
        data_end = .;
    }
    .bss : 
    {
        bss = data_end;
        *(.bss)
        bss__end = .;
    }
    end = .;
}


Y el Makefile:

Código (bash) [Seleccionar] Expandir


CPP = g++
CPP_PARAMS = -I./Kernel/ -nostdlib -nostartfiles -nodefaultlibs -masm=intel -fstrength-reduce -fomit-frame-pointer -finline-functions -nostdinc -fno-builtin
OBJECTS = Stage_3.o kernel.o screen.o string.o io.o idt.o
FAT12MAKER = ./tools/fat12maker/fat12maker


all:
nasm -fbin bootloader/Stage_1.asm -o Stage_1.bin
nasm -fbin bootloader/Stage_2.asm -o Stage_2.o

nasm -felf64 Kernel/Stage_3.asm -o Stage_3.o
$(CPP) $(CPP_PARAMS) -c Kernel/kernel.cpp -o kernel.o
$(CPP) $(CPP_PARAMS) -c Kernel/Drivers/screen.cpp -o screen.o
$(CPP) $(CPP_PARAMS) -c Kernel/string.cpp -o string.o
$(CPP) $(CPP_PARAMS) -c Kernel/io.cpp -o io.o
$(CPP) $(CPP_PARAMS) -c Kernel/idt.cpp -o idt.o

ld -nostdlib -nodefaultlibs -T linker-linux.ld $(OBJECTS) -o Kernel.o
cat Stage_2.o Kernel.o > Stage_2.bin
$(FAT12MAKER) -b Stage_1.bin -i Stage_2.bin -o Kernel.img
bochs -f bochsconf-linux

clean:
rm *.o
rm *.bin


Pero en Linux, funciona peor. Sólo funcionan las cadenas que se declaran como variables locales:

Código (cpp) [Seleccionar] Expandir


extern "C" void kmain(WORD Foo, WORD Foo2)
{
char saludo[] = "Hello!\n";
screen::clear_screen();
screen::hide_cursor();

screen::kprintf("Adios\n"); //No funciona
screen::kprintf(saludo); //Funciona


Estoy muy perdido, espero que alguien pueda echarme una mano...

Saludos.

Hola, estoy escribiendo mi propio bootloader, que se carga desde una imagen FAT12 de disquete. Utilizo bochs para la virtualización.

El problema que tengo, es que no se como trabajar con el buffer que devuelve la función int 13h cuando lees unos sectores del disquete.

Código (asm) [Seleccionar] Expandir


[bits 16]
[ORG 0]

jmp short start
nop   ; No Operation (1 byte)

OEMLabel:                     db "KERNEL  "      ; 8 characters padded with spaces
BytesPerSector:                 dw 512            ; Bytes per sector
SectorsPerCluster:                db 1            ; Sectors per cluster
ReservedSectors:                dw 1            ; Reserved Sectors (for sector 0)
NumberOfFATs:                   db 2            ; Number of FAT´s
MaxRootEntries:                dw 224            ; Number of Root Entries

NumberOfSectors:                dw 2880            ; Number of sectors
DeviceDescriptor:                db 0xF0            ; Device Descriptor 0xF0 => 1.44 MB floppy image
SectorsPerFAT:                   dw 9            ; Sectors Per FAT
SectorsPerTrack:                dw 18            ; Sectors Per Track
Sides:                         dw 2            ; Sides of disk
HiddenSectors:                   dd 0            ; Number of Hidden Sectors
LengthOfSectors:               dd 0            ; Length of sectors
DriveNo:                      db 0            ; Drive Number (0 or 1)
Flags:                         db 0            ; Additional flags
Signature:                      db 0x14            ; Signature, some number of 1 byte
VolumeID:                     dd 0xAABBCCDD      ; Volume ID
VolumeLabel:                   db "DISCO TANIS "   ; 11 characters padded with spaces
FileSystem:                   db "FAT12   "      ; 8 characters padded with spaces

;**********************************************************;
; Entry Point
; Reset the floppy disk.
; Calculate the root directory CHS address and jump to
; read_root_directory.
;**********************************************************;
start:
   jmp 07C0h:stage_1

stage_1:
   mov ax, cs
   mov ds, ax
   mov es, ax

   mov si, StringMsg
   call print_string

   xor ah, ah ; Ah = 0, reset function
   mov dl, BYTE [DriveNo]
   int 13h ; Reset Floppy Disk

   xor ax, ax

   add ax, WORD [SectorsPerFAT]
   mul BYTE [NumberOfFATs]
   add ax, WORD [ReservedSectors]
   ; AX = (SectorsPerFAT * NumberOfFATs) + ReservedSectors

   call lba2chs

   jmp short read_root_directory

read_root_directory:
   ; We have already calculated the CH = Cilynder, CL = sector and
   ; DH = Head.
   mov ax, 1000h
   mov es, ax
   mov bx, 0

   mov ah, 02h   ; Read mode
   mov al, 0Fh ; Sectors to read (512 bytes each sector)
   mov dl, BYTE [DriveNo]
   
   int 13h ;Call the interruption!
   jc .root_dir_read_error

   mov si, [1000h]
   mov dx, 512
   call print_n

        ...


Y la función print_n

Código (asm) [Seleccionar] Expandir


;**********************************************************;
; Print a string in screen
; SI => String pointer
; DX => Number of characters to print
;**********************************************************;
print_n:
   push ax
   push bx
   push cx

   mov ah, 0Eh

   xor cx, cx

   .loop:
   mov al, [si]
   int 10h
   inc cx
   cmp cx, dx
   je short .end_loop
   
   inc si
   jmp short .loop

   .end_loop:
   pop ax
   pop bx
   pop cx
   ret


El problema que tengo, está aquí:

Código (asm) [Seleccionar] Expandir


mov si, [1000h]
mov dx, 512
call print_n


Me debería escribir en pantalla en caracteres ASCII el contenido del Root Directory, pero en vez de eso, comienza a escribirme desde el sector 0, es decir, va escribiendo la propia memoria del programa...
La función lba2chs, convierte direccionamiento LBA (Logical Block Address) a CHS (Cylinder Head Sector), y funciona bien.

Espero que me podáis ayudar.

Saludos.

Hola, cree una herramienta que permite crear imágenes de disquete con el sistema de archivos FAT12.

Muchos considerarán inútil, pero le puede ser útil a aquella gente que quiera conocer como trabaja el sistema de archivos FAT12. Esta herramienta, la programé para el Kernel que estoy desarrollando. Puedes hacer un bootloader (de 512 bytes) y esta herramienta se encarga de meterla en el sector 0 de la imagen. También permite crear imágenes de disquete sin bootloader, soporta los siguientes tipos: 2880KB, 1440 KB, 1200 KB, 720 KB, 360 KB, 320 KB, 180 KB, 160 KB.

Las imágenes generadas siguen el estándar de Microsoft y pueden ser abiertas por el Nero o el UltraISO.

El código es bastante interesante, está escrito en C, creo que está bastante bien.

Código (c) [Seleccionar] Expandir


/*
* addFileFAT12()
* Add file to our FAT12_t structure
*/
int addFileFAT12(char * fileName, FAT12_t * fat12)
{
int result = 0;
linked_list_t * l = NULL;
directory_entry_t directoryEntry;

if (fat12 == NULL)
return FAT12_INVALID_FAT12_POINTER;

if (fat12->active != 0)
return FAT12_INACTIVE;

result = getDirectoryEntry(fileName, fat12, &directoryEntry);
if (result == DE_OK)
{
fat12->list.list = fat12->list.last;

l = (linked_list_t*)malloc(sizeof(linked_list_t));
if (l == NULL)
return FAT12_LINKED_LIST_MALLOC_ERR;

if (fat12->list.list == NULL)
fat12->list.list = l;
else
{
fat12->list.list->next = l;
fat12->list.list = fat12->list.list->next;
}

fat12->list.list->directoryEntry = directoryEntry;

fat12->list.list->fileName = (char *)malloc(strlen(fileName) + 1);
if (fat12->list.list->fileName == NULL)
return FAT12_LINKED_LIST_FILENAME_MALLOC_ERR;

strncpy(fat12->list.list->fileName, fileName, strlen(fileName) + 1);
//fat12->list.list->fileName = strdup(fileName);

fat12->list.list->next = NULL;

if (fat12->list.first == NULL)
fat12->list.first = fat12->list.list;

fat12->list.last = fat12->list.list;
fat12->NumberOfFiles++;

return FAT12_OK;
}
else
return result;
}

...
while (fat12->list.list != NULL)
{
sectorsCount = (unsigned short)(fat12->list.list->directoryEntry.FileSize / fat12->boot_sector.BytesPerSector) + 1;
fat12->list.list->directoryEntry.StartingCluster = LBAAddress;

printf("\nFile: %s, Size: %d bytes, Sectors count: %d, LBA Address: 0x%.4x", fat12->list.list->fileName,
fat12->list.list->directoryEntry.FileSize, sectorsCount, LBAAddress);

LBAAddress += sectorsCount;

if (sectorsCountOfNextFile != -1) //Quiere decir que ya usamos un cluster
sectorsCount--;
sectorsCountOfNextFile = -1;

fat12->list.list = fat12->list.list->next; //Preparamos el siguiente archivo
while (sectorsCount > 0)
{
switch (sectorsCount)
{
case 1:
sectorsCount = 0;
fat_entry = 0x000FFF00;

if (fat12->list.list != NULL)
{
sectorsCountOfNextFile = (unsigned short)(fat12->list.list->directoryEntry.FileSize / fat12->boot_sector.BytesPerSector) + 1;
if (sectorsCountOfNextFile == 1)
fat_entry = 0xFFFFFF00;
else
fat_entry += (nextCluster + 1) << 20;
}
break;
case 2:
fat_entry = 0xFFF00000 + (nextCluster << 8);
sectorsCount = 0;
break;
default:
fat_entry = (unsigned long)((nextCluster + 1) << 20) + (nextCluster << 8);

sectorsCount -= 2;
break;
}
nextCluster+=2;

*fatTable++ = (unsigned char)((fat_entry & 0x0000FF00) >> 8);
*fatTable++ = (unsigned char)((fat_entry & 0x00FF0000) >> 16);
*fatTable++ = (unsigned char)((fat_entry & 0xFF000000) >> 24);
}
}



Estoy haciendo más portable el código para que se pueda compilar en sistemas *nix, además, estoy escribiendo una buena documentación en español sobre el sistema de archivos FAT12.

https://sourceforge.net/projects/fat12maker/

Espero que os sea de utilidad  

Saludos.

Hola, llevo 2 meses con Arch Linux en mi netbook y me va de maravilla. El problema comenzó el otro día cuando le instalé el kernel 3.1.4-1, a veces al encender el ordenador me daba un kernel panic y ahí se quedaba... Pensé que era problema del kernel, que igual tendría algún que otro fallo así que inicié en modo de recuperación y lo sustituí por uno viejo que funcionaba perfectamente, concretamente el 3.1.1-1.

Pero con el kernel 3.1.1-1 sigue haciendo lo mismo: unas veces se produce un kernel panic al bootear y otras veces arranca perfectamente...

La verdad no se que hacer y me da pereza formatear porque tenía todo el sistema configurado a mi gusto... y no es fácil configurar un Arch...

Descartados problemas de hardware, hice test de memoria y de disco. Además tengo dual boot con Windows 7 y este funciona perfecto.

Saludos.

El otro día estaba investigando la posibilidad de ejecutar un Thread en un núcleo específico del procesador y me encontré con esta función de la API de Windows: SetThreadAffinityMask().

Se define así:

DWORD_PTR WINAPI SetThreadAffinityMask(__in HANDLE hThread, __in DWORD_PTR dwThreadAffinityMask);

Usando el siguiente programa y el taskmanager de Windows hice las siguientes pruebas:

Código (cpp) [Seleccionar] Expandir


#include <iostream>
#include <Windows.h>

using namespace std;

void threadFunc()
{
double a = 0;

for (unsigned long long i = 0;;i++)
{
a = (i * 17) - 32;
if (a > 0)
a = (sqrt(a) * 43) - 72;
}
}

int main(int argc, char * argv[])
{
SYSTEM_INFO sysInfo;
DWORD dwThreadId;

GetSystemInfo(&sysInfo);
cout << "Numero de nucleos: " << sysInfo.dwNumberOfProcessors << endl << endl;

BYTE coreToUse = 0; //Empieza en el 0
HANDLE hThread = CreateThread(NULL, 0, (LPTHREAD_START_ROUTINE)threadFunc, NULL, 0, &dwThreadId);

if (SetThreadAffinityMask(hThread, 1 << (coreToUse % 8)) != 0)
cout << "ThreadAffinity se establecio con exito en el nucleo " << (int)coreToUse << endl;
else
cout << "ThreadAffinity error! El sistema repartira la carga del Thread!" << endl;

cin.get();

return 0;
}


En la variable coreToUse especificas que núcleo que vas a usar para ejecutar el thread con la función threadFunc(). En mi caso tengo como procesador un AMD Athlon X 2 6400 - 3.2 GHz, por lo tanto sólo tiene 2 núcleos.



Como podéis ver en la imagen, el primer núcleo se pone al 100%.. Ahora voy a hacer lo mismo, pero poniendole el valor 1 a la variable coreToUse.



¿Qué pasaría si le pongo un valor mayor que 1? Pues en mi caso, como solo tiene 2 núcleos mi procesador, fallaría la función SetThreadAffinityMask() y por lo tanto el sistema repartiría la carga de la función threadFunc().



No trabajan los dos núcleos lo mismo, siempre va a trabajar más uno que otro, pero eso depende de los algoritmos de planificación del scheduler del kernel de Windows...

Y ahora viene la gran pregunta, ¿Vale la pena utilizar esta API? La verdad, yo no le encontré gran utilidad. Quizás con 2 núcleos no te sirva de mucho, pero con 8 o 12 núcleos se podrían hacer bastantes cosas a la vez. Supongo que para los videojuegos o programas que necesiten gran capacidad de cálculo les será útil. Aunque siempre dependes de la cantidad de núcleos que tenga el equipo que ejecute tu programa.

Saludos.

Hola, estoy haciendo un proyecto en C# y C++ con el Visual Studio. La interfaz está hecha en C# y el "corazón" del programa está en una librería hecha en C++.

Código (cpp) [Seleccionar] Expandir


#include <Windows.h>
//#include "core.h"
#include <curl/curl.h>

extern "C" __declspec(dllexport) int StartXModule();

BOOL APIENTRY DllMain( HANDLE hModule,
                        DWORD  ul_reason_for_call,
                        LPVOID lpReserved )
{
    return TRUE;
}


int StartXModule()
{
curl_global_init(CURL_GLOBAL_DEFAULT);
return 0;
}


La llamada de la función desde C# se hace aquí:

Código (csharp) [Seleccionar] Expandir


[DllImport("x-module.dll")]
        private static extern int StartXModule();

        private void FMain_Load(object sender, EventArgs e)
        {
            PMain.BackColor = System.Drawing.ColorTranslator.FromWin32(0x00373737);
            //for (int i = 0; i < 30; i++)
            //    listBoxX1.Items.Add("qdwqdqw");
            StartXModule();
        }


Depurando desde el Visual C# la aplicación se ejecuta correctamente, pero generando la aplicación y ejecutando directamente me da este error:

No se puede cargar el archivo DLL "x-module.dll". No se puede encontrar el módulo especificado. (Excepción de HRESULT: 0x8007007E).

Mi aplicación la forman 2 librerías (libcurl.dll y x-module.dll) y la aplicación hecha en C#. El problema creo que está en que no tiene acceso a la función curl_globla_init() llamando a StartXModule() desde C#, porque si comento esa línea, la función se carga correctamente.

Espero que me podáis ayudar.. Saludos.

Hola, hace un mes un compañero y yo teníamos que crear una web como proyecto para la asignatura de Implementación de Aplicaciones Informáticas de Gestión. Mi clase y yo, nos pasábamos todo el día metidos en páginas tipo desmotivaciones y de memes. Así que pensamos en crear una web de ese estilo.

Nos llevó cerca de un mes, la desarrollamos en MySQL y PHP con xampp. Hace una semana decidimos colgarla en Internet y compramos un hosting LAMP. Todavía tiene algún que otro fallo y está un poco verde.



Espero que os guste, se aceptan críticas y sugerencias.

http://aburrimientomaximo.com/

Saludos.

Código (delphi) [Seleccionar] Expandir


(*
* PEFileSize function, inspired by The Swash
* by Khronos
*)

function PEFileSize(FileName: string): Cardinal;
var
i: integer;
FileStream: TFileStream;
IDH: IMAGE_DOS_HEADER;
INH: IMAGE_NT_HEADERS;
ISH: IMAGE_SECTION_HEADER;
begin
result:= 0;
  try
    FileStream:= TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
    FileStream.Read(IDH, SizeOf(IDH));
    if IDH.e_magic = IMAGE_DOS_SIGNATURE then
      begin
        FileStream.Seek(IDH._lfanew, 0);
        FileStream.Read(INH, SizeOf(INH));
        if INH.Signature = IMAGE_NT_SIGNATURE then
          begin
            for I := 0 to INH.FileHeader.NumberOfSections - 1 do
              begin
                FileStream.Seek(IDH._lfanew + SizeOf(INH) + SizeOf(ISH) * i, 0);
                FileStream.Read(ISH, SizeOf(ISH));
                result:= result + ISH.SizeOfRawData;
              end;
            result:= result + INH.OptionalHeader.SizeOfHeaders;
          end;
      end;
  finally
    FileStream.Free;
  end;
end;


Saludos.

[URL]

Hace algún tiempo cree una función para descargar un archivo de una página web en Delphi. Hoy decidí mejorarla un poco y tiene algunas novedades:

- La función se ejecuta dentro de un Thread, por lo que no afecta al rendimiento de la aplicación ni hace que se congele.
- Para descargar el archivo me conecto al servidor trabajando directamente con sockets y consultas HTTP.
- Incluye 3 eventos: OnStartDownload, OnProgress y OnFinishDownload.

Código (delphi) [Seleccionar] Expandir

procedure DownloadFile(URL: AnsiString; FileName: String; StartDownload: TOnStartDownload;  
         Progress: TOnProgress; FinishDownload: TOnFinishDownload);

URL: Es la dirección del archivo web a descargar.
FileName: Es la ruta donde vas a guardar el archivo descargado.
StartDownload: Es un puntero a una función, este se ejecutará al comenzar la descarga. Devuelve como parámetro el tamaño del archivo, si se conoce.
Progress: Es un puntero a una función, este se ejecuta a medida que se va descargando el archivo. Este evento, puede ser útil si quieres mostrar el progreso de la descarga en un TProgressBar, por ejemplo.
FinishDownload: Es un puntero a una función, este se ejecuta si se produce algún error en la descarga o al terminar la descarga. Tiene como parámetro ErrorCode, de tipo byte, si ErrorCode es 0 significa que la descarga se completó con éxito.

A continuación el código de la unidad:

Código (delphi) [Seleccionar] Expandir


unit URLDown;

(*
* *****************************************************************************
* ***************************   Unidad URLDown  *******************************
*    Esta unidad contiene la función DownloadFile, una función que
* descarga un archivo desde una dirección URL. Esta función se ejecuta en
* otro thread, por lo que no "congela" la aplicación ni causa inastabilidad.
* Además, cuenta con 3 eventos: OnStartDownload, OnProgress y OnFinishDownload.
*
* Autor: Khronos
* Email: khronos14@hotmail.com
* Blog: khronos14.blogspot.com
*******************************************************************************
*)

interface

uses SysUtils, Classes, Windows, WinSock;

{$DEFINE OBJECT_FUNCTIONS}
(*
 Si borras la definición OBJECT_FUNCTIONS, los eventos
 de la función DownloadFile no serán de tipo objeto.
 Para emplear esta función en modo consola o sin clases,
 comenta esta definición.
*)

const
 SZBUFFER_SIZE   = 2048; //Este es el tamaño del buffer de descarga

 URLDOWN_OK                    = 0;
 URLDOWN_INVALID_HOST          = 1;
 URLDOWN_CONNECT_ERROR         = 2;
 URLDOWN_DOWNLOAD_ERROR        = 3;
 URLDOWN_UNKNOWN_ERROR         = $FD;

type
 TOnStartDownload = procedure(FileSize: int64) {$IFDEF OBJECT_FUNCTIONS}of object{$ENDIF};
 TOnProgress = procedure(Progress: int64) {$IFDEF OBJECT_FUNCTIONS}of object{$ENDIF};
 TOnFinishDownload = procedure(ErrorCode: byte) {$IFDEF OBJECT_FUNCTIONS}of object{$ENDIF};

 TDownloadVars = record
   URL: AnsiString;
   FileName: String;
   OnStartDownload: TOnStartDownload;
   OnProgress: TOnProgress;
   OnFinishDownload: TOnFinishDownload;
 end;
 PDownloadVars = ^TDownloadVars;

procedure DownloadFile(URL: AnsiString; FileName: String; StartDownload: TOnStartDownload;
         Progress: TOnProgress; FinishDownload: TOnFinishDownload); stdcall;

implementation


function GetDomainName(const URL: AnsiString): AnsiString;
var
P1: integer;
begin
 P1:= Pos('http://', URL);
 if P1 > 0 then
  begin
    result:= Copy(URL, P1 + 7, Length(URL) - P1 - 6);
    P1:= Pos('/', result);
    if P1 > 0 then
      result:= Copy(result, 0, P1 - 1);
  end else
    begin
      P1:= Pos('/', URL);
      if P1 > 0 then
        result:= Copy(URL, 0, P1 - 1)
      else result:= URL;
    end;
end;

function GetFileWeb(const URL: AnsiString): AnsiString;
var
P1: integer;
begin
 P1:= Pos('http://', URL);
 if P1 > 0 then
  begin
    result:= Copy(URL, P1 + 7, Length(URL) - P1 - 6);
    P1:= Pos('/', result);
    if P1 > 0 then
      result:= Copy(result, P1, Length(result) - P1 + 1);
  end else
    begin
      P1:= Pos('/', URL);
      if P1 > 0 then
        result:= Copy(URL, P1, Length(URL) - P1 + 1)
      else result:= URL;
    end;
 if result = GetDomainName(URL) then
   result:= '/';
end;

procedure CleanHttp(var Mem: TMemoryStream);
var
i: integer;
Separator: array [0..3] of AnsiChar;
Mem2: TMemoryStream;
begin
if Assigned(Mem) then
  begin
    for i := 0 to Mem.Size - 1 do
      begin
        Mem.Seek(i, 0);
        Mem.Read(Separator, 4);
        if (Separator[0] = #13) and (Separator[1] = #10) and (Separator[2] = #13)
            and (Separator[3] = #10) then
              begin
                Mem2:= TMemoryStream.Create;
                Mem.Seek(i + 4, 0);
                Mem2.CopyFrom(Mem, Mem.Size - I - 4);
                Mem:= Mem2;
                break;
              end;
      end;
  end;
end;

function SendQuery(Socket: TSocket; RHost: sockaddr_in; Query: AnsiString): boolean;
begin
if Connect(Socket, PSockAddrIn(@RHost)^, Sizeof(RHost)) = 0 then
 begin
   send(Socket, Pointer(Query)^, Length(Query), 0);
   result:= true;
 end else
   result:= false;
end;

function CreateQuery(URL: AnsiString): AnsiString;
begin
 result:= 'GET ' + GetFileWeb(URL) + ' HTTP/1.0' + #13#10 +
   'Host: ' + GetDomainName(URL) +  #13#10 +
   'User-Agent: Khronos' + #13#10#13#10;
end;

function GetContentLength(szBuff: AnsiString; Size: Cardinal): int64;
var
dwStart, dwEnd: integer;
ContentLength: AnsiString;
begin
Result:= 0;
 dwStart:= Pos('Content-Length: ', szBuff);
 if dwStart <> 0 then
   begin
     dwStart:= dwStart + StrLen('Content-Length: ');
     dwEnd:= dwStart;
     repeat
       Inc(dwEnd);
     until (szBuff[dwEnd] = #0) or (szBuff[dwEnd] = #13) or (dwEnd = Size);
     ContentLength:= Copy(szBuff, dwStart, dwEnd - dwStart);
     if TryStrToInt64(ContentLength, Result) = false then
       result:= -1;
   end;
 dwStart:= Pos(#13#10#13#10, szBuff);
end;

function InitializeWinSock(Host: AnsiString; var Socket: TSocket; var RHost: sockaddr_in): boolean;
var
WSA: TWSAData;
Addr: u_long;
Hostent: PHostent;
Ip: ^Integer;
begin
If WSAStartup(MakeWord(2,2), WSA) = 0 then
 begin
    Socket:= WinSock.SOCKET(AF_INET, SOCK_STREAM, 0);
    if Socket <> INVALID_SOCKET then
       begin
         Hostent:= GetHostByName(PAnsiChar(GetDomainName(Host)));
         if Hostent <> nil then
           begin
             Ip:= @Hostent.h_addr_list^[0];
             RHost.sin_family:= AF_INET;
             RHost.sin_port:= htons(80);
             RHost.sin_addr.S_addr:= ip^;
             result:= true;
          end;
       end;
 end else
   result:= false;
end;

function ProcessDownload(Socket: TSocket; FileName: WideString; StartDownload: TOnStartDownload;
         Progress: TOnProgress; FinishDownload: TOnFinishDownload): boolean;
var
szBuffer: array [0..SZBUFFER_SIZE] of AnsiChar;
Stream: TMemoryStream;
ContentLength, ReturnCode: integer;
begin
result:= false;
   try
     Stream:= TMemoryStream.Create;
     ContentLength:= 0;
     repeat
       FillChar(szBuffer, SZBUFFER_SIZE, 0);
       ReturnCode:= recv(Socket, szBuffer, SZBUFFER_SIZE, 0);
       if (ContentLength = 0) and (ReturnCode > 0) then
         begin
           ContentLength:= GetContentLength(szBuffer, ReturnCode);
           if Assigned(StartDownload) then
             StartDownload(ContentLength);
         end;
       if ReturnCode > 0 then
         begin
           Stream.Write(szBuffer, ReturnCode);
           if Assigned(Progress) then
               Progress(Stream.Position);
         end;
     until ReturnCode <= 0;
     if Stream.Size > 0 then
       begin
         CleanHttp(Stream);
         Stream.SaveToFile(FileName);
         if Assigned(FinishDownload) then
           FinishDownload(URLDOWN_OK);
         result:= true;
       end;
   finally
     Stream.Free;
   end;
end;

procedure Download(P: Pointer);
var
Query: AnsiString;
Socket: TSocket;
RHost: sockaddr_in;
begin
 try
   if InitializeWinSock(TDownloadVars(P^).URL, Socket, RHost) then
     begin
       Query:= CreateQuery(TDownloadVars(P^).URL);
       if SendQuery(Socket, RHost, Query) then
         begin
           If ProcessDownload(Socket, TDownloadVars(P^).FileName, TDownloadVars(P^).OnStartDownload,
               TDownloadVars(P^).OnProgress, TDownloadVars(P^).OnFinishDownload) = false then
               if Assigned(TDownloadVars(P^).OnFinishDownload) then
                 TDownloadVars(P^).OnFinishDownload(URLDOWN_DOWNLOAD_ERROR);
           ShutDown(Socket, SD_BOTH);
           CloseSocket(Socket);
         end else
           if Assigned(TDownloadVars(P^).OnFinishDownload) then
             TDownloadVars(P^).OnFinishDownload(URLDOWN_CONNECT_ERROR);
     end else
       if Assigned(TDownloadVars(P^).OnFinishDownload) then
         TDownloadVars(P^).OnFinishDownload(URLDOWN_INVALID_HOST);

   WSACleanUp();
   Dispose(PDownloadVars(P));
 Except on Exception do
   begin
     if Assigned(TDownloadVars(P^).OnFinishDownload) then
         TDownloadVars(P^).OnFinishDownload(URLDOWN_UNKNOWN_ERROR);
   end;
 end;
end;

procedure DownloadFile(URL: AnsiString; FileName: String; StartDownload: TOnStartDownload;
         Progress: TOnProgress; FinishDownload: TOnFinishDownload);
var
DownloadVars: ^TDownloadVars;
begin
 New(DownloadVars);
 DownloadVars^.URL:= URL;
 DownloadVars^.FileName:= FileName;
 DownloadVars^.OnStartDownload:= StartDownload;
 DownloadVars^.OnProgress:= Progress;
 DownloadVars^.OnFinishDownload:= FinishDownload;

 BeginThread(nil, 0, @Download, DownloadVars, 0, PDWORD(0)^);
end;


end.


Subí a MegaUpload un programa de prueba que usa la función, además incluye todo el código fuente.

http://www.megaupload.com/?d=GU5P5QDW

Saludos.

Hola, pues estoy empezando a programar con gtk+ en GNU/Linux y me surgió una duda:
¿Las aplicaciones programadas con gtk+ necesitarán dependencias externas para funcionar en escritorios con KDE o XFce?

Saludos.

Hola, practicando un poco con punteros me surgió un problema. Estoy creando una clase llamada TStringList (como la que existe en Delphi) y creé una función Add(). Funciona bastante bien, el problema ocurre cuando introduces más de 5 o 6 cadenas, que la primera cadena se pierde y salen caracteres raros.

Código main.

Código (cpp) [Seleccionar] Expandir


#include <iostream>
#include "stringlist.h"

using namespace std;

const int CHAR_MAX_LENGTH = 20;

int showmenu()
{
int option = 0;
   do
   {
       cout << "1.- Añadir string" << endl;
       cout << "2.- Mostrar strings" << endl;
       cout << "3.- Salir" << endl;
       cout << "Introduce una opcion: ";
       cin >> option;
   }while(option < 1 && option > 3);
return option;
}

int main()
{
char buff[CHAR_MAX_LENGTH];
int option = 0;
TStringList *List = new TStringList();
       do
       {
           option = showmenu();
           switch(option)
           {
               case 1: cout << "Introduce una cadena: ";
                       cout.flush();
                       cin >> buff;
                       List->Add(buff);
                       break;
               case 2: for (int i = 0; i < List->GetCount(); i++)
                           cout << "Item " << i + 1 << ": " << List->GetItem(i) << endl;

                       break;
           }

       }while(option != 3);
delete(List);
return 0;
}



Código stringlist.h

Código (cpp) [Seleccionar] Expandir


#ifndef _H_STRINGLIST
#define _H_STRINGLIST

struct SL_ITEM{
   char *string;
};

class TStringList{
   private:
       SL_ITEM *Items;
       long numItems;
   public:
       TStringList();
       ~TStringList();
       void Add(char *cadena);
       long GetCount();
       char * GetItem(long Index);
};

#endif



Código stringlist.cpp

Código (cpp) [Seleccionar] Expandir


#include "stringlist.h"
#include <memory>
#include <malloc.h>
#include <string.h>

TStringList::TStringList()
{
   numItems = 0;
}

TStringList::~TStringList()
{
   if (numItems > 0)
   {
           for (int i = 0; i < numItems; i++)
               Items[i].string = NULL;
           Items = NULL;
        /*
             Aquí también tengo alguna duda.
             Probé con delete [] Items; pero compilado en Linux me suelta un stack error, en Windows, simplemente se cierra la aplicación  :huh:
        */
   }

}

void TStringList::Add(char *cadena)
{
   if (numItems > 0){
       SL_ITEM * NewItems = (SL_ITEM*) malloc((numItems + 1) * sizeof(SL_ITEM));
       /*for (int i = 0; i < numItems; i++)
           {
               NewItems[i].string = (char *) malloc(strlen(Items[i].string) + 1);
               strcpy(NewItems[i].string, Items[i].string);
           }*/
       memcpy(NewItems, Items, sizeof(*Items));
       memcpy(Items, NewItems, sizeof(*NewItems));
       NewItems = NULL; //Creo que no hace falta
   }
   else Items = (SL_ITEM*) malloc(sizeof(SL_ITEM));
       Items[numItems].string = (char *) malloc(strlen(cadena) + 1);
       strcpy(Items[numItems].string, cadena);
       numItems++;
}

long TStringList::GetCount()
{
   return numItems;
}

char * TStringList::GetItem(long Index)
{
   if (Index < numItems && Index >= 0)
       return Items[Index].string;
   else return NULL;
}



Espero que puedan echarle un ojo y comentar.

Saludos.

Hace algún tiempo hice el juego del 3 en raya para jugar con la máquina. La máquina decide donde mover de forma aleatoria y/o combinando las posibilidades que tiene de perder o de ganar. Es decir, si tiene 2 fichas en una línea y le falta 1 para ganar, gana la partida, si no, evita perder la partida o mueve de forma aleatoria.

Se podrían programar una serie de jugadas para dotar al sistema de cierta "inteligencia" pero eso ya es otra historia 





Y aquí tenéis todo el código fuente con el ejecutable compilado:

http://www.megaupload.com/?d=Y0HL5SUW

Saludos.

[no posteéis aquí]

Hola, abro este hilo para empezar un curso de introducción a Delphi. Antes de nada, aclaro que no necesitas conocimientos previos de programación para seguir el curso y que para preservar la integridad del curso no posteéis aquí.

Para este curso voy a emplear la versión de Delphi 2010. A partir de Delphi 2007, se incluyeron mejoras notables como UNICODE nativo, soporte para interfaces táctiles y los genéricos en la sintaxis de Delphi, así que para seguir este curso recomiendo usar Delphi 2009 o superior.

• Capítulo 1. Delphi.
• Capítulo 2. ¡Hola Mundo!
• Capítulo 3. Tipos de datos.
• Capítulo 4. Operadores.
• Capítulo 5. Condicionales y saltos.
• Capítulo 6. Bucles.
• Capítulo 7. Procedimientos y Funciones I.
• Capítulo 8. Vectores I.
• Capítulo 9. Estructuras.
• Capítulo 10. Punteros I.

NOTA: Si tenéis alguna duda/consejo sobre el curso o sobre cualquier cuestión de Delphi podéis consultarme por mp.

En una tarde de aburrimiento, se me ocurrió hacer una función para descargar archivos de un servidor web utilizando Sockets.
Es una función alternativa a la API URLDownLoadToFile o a la API de WinInet.

Código (delphi) [Seleccionar] Expandir


uses SysUtils, Classes, Windows, Forms, WinSock;

{Función: GetDomainName
Ejemplo: Si le pasas "http://foro.elhacker.net/post.html;board=18.0"
como parámetro te devuelve "foro.elhacker.net"}
function GetDomainName(const URL: AnsiString): AnsiString;
var
P1: integer;
begin
  P1:= Pos('http://', LowerCase(URL));
  if P1 > 0 then
   begin
     result:= Copy(lowercase(URL), P1 + 7, Length(URL) - P1 - 6);
     P1:= Pos('/', result);
     if P1 > 0 then
       result:= Copy(result, 0, P1 - 1);
   end else
     begin
       P1:= Pos('/', URL);
       if P1 > 0 then
         result:= Copy(Lowercase(URL), 0, P1 - 1)
       else result:= LowerCase(URL);
     end;
end;

{Función: GetFileWeb
Ejemplo: Si le pasas "http://foro.elhacker.net/post.html;board=18.0"
como parámetro te devuelve "post.html;board=18.0"}
function GetFileWeb(const URL: AnsiString): AnsiString;
var
P1: integer;
begin
  P1:= Pos('http://', LowerCase(URL));
  if P1 > 0 then
   begin
     result:= Copy(lowercase(URL), P1 + 7, Length(URL) - P1 - 6);
     P1:= Pos('/', result);
     if P1 > 0 then
       result:= Copy(result, P1, Length(result) - P1 + 1);
   end else
     begin
       P1:= Pos('/', URL);
       if P1 > 0 then
         result:= Copy(LowerCase(URL), P1, Length(URL) - P1 + 1)
       else result:= LowerCase(URL);
     end;
end;

{Función: CleanHTTP
Esta función se encarga de eliminiar las líneas de control
que emplea el protocolo HTTP. El archivo comienza despues de #13#10#13#10.

Un ejemplo de las líneas que vamos a quitar con esta función:

HTTP/1.0 200 OK
Date: Sat, 07 Aug 2010 23:25:05 GMT
Expires: -1
Cache-Control: private, max-age=0
Content-Type: text/html; charset=ISO-8859-1
Set-Cookie: PREF=ID=45985543825451c0:TM=1281223505:LM=1281223505:S=kPYwkz3GOI3idLv6; expires=Mon, 06-Aug-2012 23:25:05 GMT; path=/; domain=.google.es
Set-Cookie: NID=37=rPl51eNebbKvxz3Abvlpje8AT-qMszIbpmDR-zJJjYlwRie55cmev5KE45t4kBPVmhsHPpWUqBwzwqI4rsndihEbd0OtrMJfMohVYI0lfxJ3U1uchrbJMA4SUVh2-uNz; expires=Sun, 06-Feb-2011 23:25:05 GMT; path=/; domain=.google.es; HttpOnly
Server: gws
X-XSS-Protection: 1; mode=block
}
procedure CleanHttp(var Mem: TMemoryStream);
var
i: integer;
Separator: array [0..3] of AnsiChar;
Mem2: TMemoryStream;
begin
 if Assigned(Mem) then
   begin
     for i := 0 to Mem.Size - 1 do
       begin
         Mem.Seek(i, 0);
         Mem.Read(Separator, 4);
         if (Separator[0] = #13) and (Separator[1] = #10) and (Separator[2] = #13)
             and (Separator[3] = #10) then
               begin
                 Mem2:= TMemoryStream.Create;
                 Mem.Seek(i + 4, 0);
                 Mem2.CopyFrom(Mem, Mem.Size - I - 4);
                 Mem:= Mem2;
                 break;
               end;
       end;
   end;
end;


{Función DownLoadFile
URL: La dirección del archivo que vas a descargar.
FileName: La ruta donde vas a guardar el archivo
ProcessMessages: Por defecto está a True, hace que no se bloquee
la aplicación con el bucle. Puedes cambiar su valor a False o eliminar la línea
"if ProcessMessages then Application.ProcessMessages;" y los uses "Forms" si vas a
trabajar en modo consola

Devuelve True si tiene éxito}
function DownLoadFile(const URL: AnsiString; FileName: String; ProcessMessages: boolean = true): boolean;
var
WSA: TWSAData;
Sock: TSocket;
Hostent: PHostent;
Ip: ^Integer;
ReturnCode, i: integer;
RHost: sockaddr_in;
Http: AnsiString;
szBuffer: array [0..1023] of AnsiChar;
Stream: TMemoryStream;
begin
result:= false;
 If WSAStartup(MakeWord(2,2), WSA) = 0 then
   begin
     Sock:= SOCKET(AF_INET, SOCK_STREAM, 0);
     if Sock <> INVALID_SOCKET then
         Hostent:= GetHostByName(PAnsiChar(GetDomainName(URL)));
         if Hostent <> nil then
           begin
             Ip:= @Hostent.h_addr_list^[0];
             RHost.sin_family:= AF_INET;
             RHost.sin_port:= htons(80);
             RHost.sin_addr.S_addr:= ip^;
             if Connect(Sock, RHost, Sizeof(RHost)) = 0 then
               begin
                 Http:= 'GET ' + GetFileWeb(URL) + '   HTTP/1.0'#13#10 +
                 'Host: ' + GetDomainName(URL) +  #13#10#13#10;
                 send(Sock, Pointer(Http)^, Length(Http), 0);

                 try
                 Stream:= TMemoryStream.Create;
                   repeat
                     if ProcessMessages then Application.ProcessMessages;
                     FillChar(szBuffer, SizeOf(szBuffer), 0);
                     ReturnCode:= recv(Sock, szBuffer, sizeof(szBuffer), 0);
                     if ReturnCode > 0 then
                       Stream.Write(szBuffer, ReturnCode);
                   until ReturnCode <= 0;
                 CleanHttp(Stream);
                 if Stream.Size > 0 then
                     begin
                        result:= true;
                       Stream.SaveToFile(FileName);
                     end;
                 finally
                   Stream.Free;
                 end;

                 ShutDown(Sock, SD_BOTH);
                 CloseSocket(Sock);
               end;
           end;
   end;
 WSACleanUp;
end;


Un ejemplo de uso:

Código (delphi) [Seleccionar] Expandir


DownLoadFile('http://www.google.es', 'C:\google.html');


Saludos.